'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'entwickelt von Winfried Radner
'e-mail: Wolf.W.Radzinski@gmx.de
'Benutzung frei - ohne Gewähr
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+
'+  sucht nach "suchwort" im Bereich "in_selection" und markiert ab der
'+  "gefundenen" Zelle "anzahl_zeilen" GANZE Zeilen
'+  und entfernt diese Zeilen aus der Tabelle
'+  mit i.clear würden nur die Inhalte entfernt
'+
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Sub suche_und_loesche_zeilen(suchwort As String, _
                                                             in_selection As Range, _
                                                             anzahl_zeilen As Integer)

Dim r As Range, r1 As Range
Dim c As New Collection
Dim sel As Range
Dim i As Range

Set ac = ActiveCell

mylookat = xlPart   'nur Teil des Feldes
mymatchcase = False 'groß oder klein

Set sel = ActiveSheet.UsedRange  ' usedrange wird NEU berechent
Set sel = Intersect(sel, in_selection) 'die Auswahl wird auf Usedrange begrenzt
Set r = sel.Find(suchwort, LookAt:=mylookat, MatchCase:=mymatchcase)
Set r1 = r

Do While Not r Is Nothing
     c.Add r.Resize(anzahl_zeilen).EntireRow  'ganze Zeile(n) markieren und merken
     
     Set r = sel.FindNext(r)  'nächsten Treffer suchen
     If r.Address = r1.Address Then Set r = Nothing 'Abbruch wenn wieder am Anfang
     Loop

'c enthält jetzt alle Trefferzeilen
'lösche Inhalt von c aus der Tabelle
If IsError(c.Count) Then Exit Sub  'da nichts gefunden!

Application.ScreenUpdating = False
For Each i In c
   i.Delete shift:=xlUp
   Next i
Application.ScreenUpdating = True

ActiveCell.Select
End Sub
                                                  

'und so wird das obige Makro verwendet
'es sucht nach Lieferant innerhalb einer Zelle in Spalte B und löscht
'diese Zeile UND 2 weitere Zeilen darunter

Sub finde_und_loesche()
   suche_und_loesche_zeilen "Lieferant", [B:B], 3
End Sub