Sub
Delete()
With
Tabelle1.UsedRange
With
.Columns(.Columns.Count).Offset(, 1)
If
.Cells.Count > 1
Then
.Formula =
"=IF(MOD(ROW()-ROW("
& .Cells(1, 1).Address &
"),10),1,"
""
")"
.Value = .Value
On
Error
Resume
Next
Call
.SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow.Delete
On
Error
GoTo
0
Call
.Clear
End
If
End
With
With
.Rows(.Rows.Count).Offset(1)
If
.Cells.Count > 1
Then
.Formula =
"=IF(MOD(COLUMN()-COLUMN("
& .Cells(1, 1).Address &
"),10),1,"
""
")"
.Value = .Value
On
Error
Resume
Next
Call
.SpecialCells(xlCellTypeConstants, xlNumbers).EntireColumn.Delete
On
Error
GoTo
0
Call
.Clear
End
If
End
With
End
With
End
Sub