VB in Excel: Alle Zeilen löschen die bestimmtes Wort "beinhalten"

Sub BegriffSuchenUndZeilenLöschen()
  Dim Suchbegriff As String
  Dim Zeilen As Range, ersteZelle As Range, Zelle As Range
  Suchbegriff = Fon
  Set ersteZelle = Cells.Find(Suchbegriff, LookAt:=xlWhole)
  If ersteZelle Is Nothing Then
    MsgBox Suchbegriff nicht gefunden !
  Else
    Set Zeilen = ersteZelle
    Set Zelle = ersteZelle
    Do
      Set Zelle = Cells.FindNext(after:=Zelle)
      If Not Zelle Is Nothing Then
        Set Zeilen = Union(Zeilen, Zelle)
      End If
    Loop Until Zelle.Address = ersteZelle.Address
    If MsgBox(Folgende Zeilen KOMPLETT Löschen ? & vbLf & vbLf & Zeilen.Address, _
      vbYesNo + vbQuestion, Gefundene Zellen) = vbYes Then
      Zeilen.EntireRow.Delete
    End If
  End If
End Sub