Hallo zusammen,

folgendes Problem:

Ich möchte, wenn in der Spalte G der Text "*Flotte" steht, dass in dieser Zeile einige Zellen gelöscht werden.

Mein Versuch:

Sub Löschen_der_Zeile()

Dim c As Range
Dim Bereich As Range

Dim ZeileMax As Long
ZeileMax = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

Set Bereich = Range("A1:GJ" & ZeileMax)

 
For Each Cell In Bereich


Select Case Cell.Text

 

    Case "*FLOTTE"

    With ActiveSheet.Range("G1:G" & ZeileMax)
      Set c = .Find("*FLOTTE")

      If Not c Is Nothing Then

      .Rows(c.Row).EntireRow.Cells(1).ClearContents
      .Rows(c.Row).EntireRow.Cells(9).ClearContents
      .Rows(c.Row).EntireRow.Cells(10).ClearContents
      .Rows(c.Row).EntireRow.Cells(11).ClearContents
      .Rows(c.Row).EntireRow.Cells(12).ClearContents
      .Rows(c.Row).EntireRow.Cells(13).ClearContents
      .Rows(c.Row).EntireRow.Cells(14).ClearContents
      .Rows(c.Row).EntireRow.Cells(15).ClearContents
      .Rows(c.Row).EntireRow.Cells(19).ClearContents
      .Rows(c.Row).EntireRow.Cells(20).ClearContents
      .Rows(c.Row).EntireRow.Cells(21).ClearContents
      .Rows(c.Row).EntireRow.Cells(22).ClearContents
      .Rows(c.Row).EntireRow.Cells(23).ClearContents
      .Rows(c.Row).EntireRow.Cells(24).ClearContents
      .Rows(c.Row).EntireRow.Cells(25).ClearContents
      .Rows(c.Row).EntireRow.Cells(26).ClearContents
      .Rows(c.Row).EntireRow.Cells(27).ClearContents
      .Rows(c.Row).EntireRow.Cells(189).ClearContents
      .Rows(c.Row).EntireRow.Cells(190).ClearContents
      .Rows(c.Row).EntireRow.Cells(191).ClearContents
      .Rows(c.Row).EntireRow.Cells(192).ClearContents

      End If

      End With
     
     
End Select

Next

End Sub

Wo liegt der Fehler?

Es wird immer nur für den ersten Treffer durchgeführt.

Vielen Dank im Voraus.

Ich verzweifele langsam.