VBA Fehler 1004 Delete Methode konnte niht ausgeführt werden beim Löschen von Zeilen

[clemetti]

Hallo, Ich habe folgenden Code mit dem ich alle Zeilen löschen möchte die in Spalte D den Teilstring "TEST" enthalten. Das funktioniert in meiner Beispieldatei ohne Probleme, in meiner eigentlichen Datei mit mehr Tabellenblättern und Makros kommt allerdings die Fehlermeldung "Laufzeitfehler 1004 die Delete-Methode des Range Objektes konnte nicht ausgeführt werden". Ich habe im Netz ähnliche Probleme von anderen Usern gefunden, leider hat keine der Lösungen geholfen. Das Makro wird über einen Button aktiviert. Freue mich über jeden Tipp.

Code:

Sub Musterportfolien_Summenzeilen_Loeschen()

Dim rngSuchbereich As Range, rngGefunden As Range, rngLoeschen As Range, strSuchbegriff As String, strErste As String

Set rngSuchbereich = ThisWorkbook.ActiveSheet.Columns("D")
Set rngGefunden = rngSuchbereich.Find(what:="TEST", LookIn:=xlValues, lookat:=xlPart, MatchCase:=True)
If Not rngGefunden Is Nothing Then
   Set rngLoeschen = rngGefunden
   strErste = rngGefunden.Address
   Do
       Set rngLoeschen = Union(rngLoeschen, rngGefunden)
       Set rngGefunden = rngSuchbereich.FindNext(rngGefunden)
       If rngGefunden Is Nothing Then Exit Do
   Loop Until rngGefunden.Address = strErste
   rngLoeschen.EntireRow.Delete
End If

End Sub

[RPP63]

Moin!
Blattschutz gesetzt?
Am Rande:
Warum setzt Du keinen Filter und löscht die sichtbaren Zeilen unterhalb der Überschriftenzeile?

Gruß Ralf

[clemetti]

Hey, 

Blattschutz ist nicht gesetzt. Grund ist, dass ich am Ende gerne nach mehren Begriffen (MUSTER, TEST, etc) sowie nach leeren Zellen suchen und alle löschen möchte. 

Begonnen hatte ich mit einem bereits vorhandenen Code der in Spalte A (enthält nur einzelnen Buchstaben) nach "S" sucht, jedoch konnte ich diesen nicht auf die Suche nach Teilstrings anpassen. Außerdem möchte ich die Suche in Spalte D durchführen, da dort die Zellen immer leer sind wenn in Spalte A ein "S" steht und manchmal eben die Teilstrings MUSTER/TEST vorkommen die ebenfalls gelöscht werden sollen. 

Code:

Sub Summenzeilen_Löschen()
Dim varList As Variant
Dim i As Integer, l As Integer
Dim lngEnde As Long
Dim Col1
Dim Suchtext As String
 
Suchtext = "S" ' Löscht alle Zeilen die in Spalte A (RowIdentifier) ein "S" enthalten
 
lngEnde = ActiveSheet.Range("A6000").End(xlUp).Row ' letzte gefüllte Zelle in Spalte A
For l = lngEnde To 2 Step -1 ' rückwärts bis  Zeile 2
    varList = Split(ActiveSheet.Cells(l, 1).Text, " ")
    For i = LBound(varList) To UBound(varList)
    If Trim(varList(i)) = Suchtext Then
      ActiveSheet.Rows(l).Delete Shift:=xlUp
    End If
    Next i
Next l
 
Suchtext = "Z" ' Löscht alle Zeilen die in Spalte A (RowIdentifier) ein "Z" enthalten
 
lngEnde = ActiveSheet.Range("A6000").End(xlUp).Row ' letzte gefüllte Zelle in Spalte A
For l = lngEnde To 2 Step -1 ' rückwärts bis  Zeile 2
    varList = Split(ActiveSheet.Cells(l, 1).Text, " ")
    For i = LBound(varList) To UBound(varList)
    If Trim(varList(i)) = Suchtext Then
      ActiveSheet.Rows(l).Delete Shift:=xlUp
    End If
    Next i
Next l
 
End Sub

Grüße 
Clemens

[Igelbauer]

Mahlzeit !
Bin mir nicht sicher, aber kann es sein, dass da noch ein
"Shift:=xlUp"  fehlt ?

Gruss Igel