habe mein Problem in der Beispieldatei beschrieben. Für Eure Hilfe wäre ich Dankbar.
Gruß Marion
https://www.herber.de/bbs/user/62728.xls
Ps. Franz hatte mir schon ein Makro gebastelt, doch leider funktioniert es nicht richtig.
Sub BegriffSuchenZeilenLoeschen()
Dim wks As Worksheet, lngZeile As Long, lngZeile1 As Long, lngZeile2 As Long
Dim varSuchen
Set wks = ActiveSheet
With wks
'Suchbegriff eingeben
varSuchen = InputBox("Suchwort?", "Wort suchen und Blöck löschen")
If varSuchen = False Or varSuchen = "" Or varSuchen = " " Then Exit Sub
'Inhalte aus Zellen mit nur Leerzeichen entfernen
For lngZeile = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
If Trim(.Cells(lngZeile, 1)) = "" Then
.Cells(lngZeile, 1).ClearContents
End If
Next
'Von unten aufwärts die letzte und 1. Zeile der Textblocke ermitteln _
und prüfen, ob Suchtext im Block enthalten
lngZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
lngZeile2 = lngZeile 'letzte Textzeile
Do Until lngZeile = 1
'1. Zeile des Blocks ermitteln
Do Until .Cells(lngZeile, 1) = ""
If lngZeile = 1 Then
lngZeile1 = lngZeile
Exit Do
End If
lngZeile = lngZeile - 1
Loop
If lngZeile1 1 Then
lngZeile1 = lngZeile + 1
End If
'Block prüfen
If Not .Range(.Cells(lngZeile1, 1), .Cells(lngZeile2, 1)).Find(what:=varSuchen, _
LookIn:=xlValues, lookat:=xlPart) Is Nothing Then
.Range(.Rows(lngZeile1), .Rows(lngZeile2)).Delete shift:=xlShiftUp
End If
'letzte Zeile des vorherigen Blocks ermitteln
Do Until .Cells(lngZeile, 1) ""
If lngZeile = 1 Then Exit Do
lngZeile = lngZeile - 1
Loop
lngZeile2 = lngZeile
Loop
End With
End Sub