in der anliegenden Datei möchte ich Zeilen löschen. Die genaue Problematik hab ich in der Datei beschrieben. Vielleicht gibts da ne Lösung. Vielen Dank im Voraus
https://www.herber.de/bbs/user/99465.xlsm
lg
Uli
Sub ZLoeschen()
Dim LetzteSpalte As Long, LetzteZeile As Long, i As Long, l As Long, AnfangZeile As Long, _
EndeZeile As Long
Dim XYZ As Variant, XYZNeu As Variant
Application.StatusBar = True
zaehler = 1
l = 0
LetzteZeile = Worksheets("Adressaten").Cells(Rows.Count, 1).End(xlUp).Row
XYZ = Range("A1:d" & LetzteZeile + 1)
For i = 1 To LetzteZeile
' Debug.Print XYZ(i, 1)
If XYZ(i, 1) = "Alexanderheim" Then
AnfangZeile = i - 1
Exit For
End If
Next i
For l = i + 1 To LetzteZeile
If XYZ(l, 1) "" And XYZ(l, 1) "Alexanderheim" And XYZ(l, 3) = "" Then
EndeZeile = l - 1
Exit For
End If
Next l
If EndeZeile > AnfangZeile Then
XYZNeu = Range("A" & AnfangZeile & ":" & "D" & EndeZeile)
ActiveSheet.Range("A1:E" & LetzteZeile + 1).ClearContents
Range("A1:D" & EndeZeile - AnfangZeile) = XYZNeu
End If
Application.StatusBar = False
End Sub
Sub ZLoeschen()
Dim LetzteSpalte As Long, LetzteZeile As Long, i As Long, l As Long, AnfangZeile As Long, _
EndeZeile As Long
Dim XYZ As Variant, XYZNeu As Variant
Application.StatusBar = True
zaehler = 1
l = 0
LetzteZeile = Worksheets("Adressaten").Cells(Rows.Count, 1).End(xlUp).Row
XYZ = Range("A1:E" & LetzteZeile + 1)
For i = 1 To LetzteZeile
' Debug.Print XYZ(i, 1)
If Left$(XYZ(i, 1), 13) = "Alexanderheim" Then
AnfangZeile = i - 1
Exit For
End If
Next i
For l = i + 1 To LetzteZeile
If XYZ(l, 1) "" And Left$(XYZ(l, 1), 13) "Alexanderheim" And XYZ(l, 4) = "" Then
EndeZeile = l - 1
Exit For
End If
Next l
If EndeZeile > AnfangZeile Then
XYZNeu = Range("A" & AnfangZeile & ":" & "D" & EndeZeile)
ActiveSheet.Range("A1:E" & LetzteZeile + 1).ClearContents
Range("A1:D" & EndeZeile - AnfangZeile) = XYZNeu
End If
Application.StatusBar = False
End Sub