Sub Makro1()
Dim loLetzte As Long, loSpalte As Long
Dim raBereich As Range, raZelle As Range, raLöschen As Range
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
loLetzte = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A1:A" & loLetzte).TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True
loSpalte = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set raBereich = .Range(.Cells(1, loSpalte), .Cells(loLetzte, loSpalte))
For Each raZelle In raBereich
Select Case raZelle
Case 0, 3, 4, 6, 249
If raLöschen Is Nothing Then
Set raLöschen = raZelle
Else
Set raLöschen = Union(raLöschen, raZelle)
End If
Case Else
End Select
Next raZelle
If Not raLöschen Is Nothing Then
raLöschen.EntireRow.Delete
End If
.Range(.Cells(1, "B"), .Cells(loLetzte, loSpalte)).EntireColumn.ClearContents
End With
Set raBereich = Nothing: Set raLöschen = Nothing
End Sub