Option
Explicit
Sub
löschen()
Dim
i
As
Long
Dim
ende
As
Long
Dim
loschen
As
String
Dim
zeilen
Application.ScreenUpdating =
False
ende = ActiveSheet.Cells(Rows.Count, 1).
End
(xlUp).Row
loschen =
""
For
i = 1
To
ende
If
ActiveSheet.Cells(i, 1) <>
""
Then
If
ActiveSheet.Cells(i + 1, 1) <>
""
And
ActiveSheet.Cells(i + 2, 3) <>
""
Then
loschen = loschen & i &
";"
End
If
End
If
Next
i
If
loschen <>
""
Then
loschen = Left(loschen, Len(loschen) - 1)
zeilen = Split(loschen,
";"
)
For
i = UBound(zeilen)
To
0
Step
-1
ActiveSheet.Rows(zeilen(i)).Delete
Next
i
End
If
Application.ScreenUpdating =
True
End
Sub