Löschen wenn Wert nicht enthalten ist

Hallo zusammen,
ich würde gerne über mehrere Tabellenbätter hinweg bestimmte Zeilen löschen lassen.
Konkret sieht es so aus: Ich habe mehrere Tabellenblätter (z.B. Deluxe, Super, Classic).
Eine Schleife soll diese 3 Blätter durchgehen und nachschauen ob jeweils in Spalte A der Name des Tabellenblatt enthalten ist.
Dabei soll das ganze Blatt mit einer weiteren Schleife durchgangen werden, um so ab der 2. Zeile jede Zeile durchzugehen.
Ist das Blatt durchlaufen, soll die erste Schleife zum nächsten Blatt gehen.
Mein bisheriger Versuch schaut so aus:


Sub loeschen()
Dim i As Long
Application.ScreenUpdating = False
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(i, 1)  "Deluxe" Then Rows(i).Delete
Next i
Application.ScreenUpdating = True
End Sub

Er löscht also innerhalb eines Blattes alles, wenn in Spalte A nicht "Deluxe" vorhanden ist.
Was ich noch nicht hinbekomme, ist die Schleife das er danach in die anderen Blätter "Super" und "Classic" geht und dann dort entsprechend die Zeilen löscht, die eben nicht "Super" bzw. "Classic" enthalten.
Ich muss also das "Deluxe" in meinem Code noch zu einer Variabeln machen...
Das ist mir bewusst, aber ich habe keine vernünftige Lösung dafür ;-)
Hoffe ihr könnt mir helfen - vielen Dank für die Mühe schon vorab!
Viele Grüße
Bastian

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Bastian,
probier mal.

' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub deluxe()
  Dim objSh As Worksheet, rngDel As Range
  Dim lngRow As Long, lngLast As Long

  For Each objSh In ThisWorkbook.Sheets(Array("Deluxe", "Super", "Classic"))
    With objSh
      lngLast = .Cells(Rows.Count, 1).End(xlUp).Row
      For lngRow = 1 To lngLast
        If .Cells(lngRow, 1) <> .Name Then
          If rngDel Is Nothing Then
            Set rngDel = .Rows(lngRow)
          Else
            Set rngDel = Union(rngDel, .Rows(lngRow))
          End If
        End If
      Next
    End With
    If Not rngDel Is Nothing Then rngDel.Delete
    Set rngDel = Nothing
  Next

End Sub

Gruß Sepp

Sub Löschen() Dim arrSheets, a arrSheets = Array("Super", "Classic", "Deluxe") For Each a In arrSheets With Sheets(a) With Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)) .Replace a, True On Error Resume Next .SpecialCells(xlCellTypeConstants, 3).EntireRow.Delete .SpecialCells(xlCellTypeBlanks).EntireRow.Delete On Error GoTo 0 .Replace True, a End With End With Next End Sub

Beliebteste Forumthreads (12 Monate)

Löschen wenn Wert nicht enthalten ist

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Löschen wenn Wert nicht enthalten ist

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread