Sub ausschneiden()
Dim intRow As Integer, intLastRow As Integer
Dim gesamt As Worksheet, unbetrachtet As Worksheet
Dim x As Long, y As Long, lngZeilen As Long
Dim rngZelle As Range
Dim lngAnz As Long
For Each rngZelle In ThisWorkbook.ActiveSheet.UsedRange
If rngZelle.HasFormula = True Then
rngZelle.Rows.Delete
lngAnz = lngAnz + 1
End If
Next rngZelle
Set gesamt = Worksheets("Gesamtauszug")
Set unbetrachtet = Worksheets("unbetrachtete Datensätze")
lngZeilen = gesamt.Cells(gesamt.Rows.Count, 1).End(xlUp).Row
x = 1
For y = 2 To lngZeilen
If Not gesamt.Cells(y, 10) Like "W*" Or gesamt.Cells(y, 3).Value Like "ROTES*" Or gesamt.Cells(y, 3).Value Like "TANKK*" Or gesamt.Cells(y, 3).Value Like "EZW*" Or gesamt.Cells(y, 3).Value Like "FREMD*" Then
gesamt.Rows(y).Cut unbetrachtet.Rows(x)
x = x + 1
End If
Next y
intLastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
For intRow = intLastRow To 1 Step -1
If Application.CountA(Rows(intRow)) = 0 Then
intLastRow = intLastRow - 1
Else
Exit For
End If
Next intRow
For intRow = intLastRow To 1 Step -1
If IsEmpty(Cells(intRow, 10)) Then
Rows(intRow).Delete
End If
Next intRow
End Sub