Option Explicit
Private Sub CommandButton1_Click()
Dim intRow As Integer, intLastRow As Integer
Dim ASH As Worksheet, gesamt As Worksheet, unbetrachtet As Worksheet
Dim x As Long, y As Long, lngZeilen As Long
Dim rngZelle As Range
Dim lngAnz As Long
Dim V1, V2, V3
Dim NWB As Workbook
With ThisWorkbook
Set ASH = .ActiveSheet
Set gesamt = .Worksheets("Gesamtauszug")
End With
For Each rngZelle In ThisWorkbook.ActiveSheet.UsedRange
If rngZelle.HasFormula = True Then
rngZelle.Rows.Delete
lngAnz = lngAnz + 1
End If
Next rngZelle
lngZeilen = gesamt.Cells(gesamt.Rows.Count, 2).End(xlUp).Row
x = 1
Set NWB = Workbooks.Add
With NWB
Set unbetrachtet = .Sheets(1)
.Sheets(1).Name = "nicht_betrachtete Datensätze"
Application.DisplayAlerts = False
.Sheets(2).Delete
.Sheets(2).Delete
Application.DisplayAlerts = True
End With
For y = 3 To lngZeilen
With gesamt
V1 = .Cells(y, 11).Value
V2 = .Cells(y, 4).Value
V3 = .Cells(y, 3).Value
End With
If Not V1 Like "W*" _
And V1 <> "" Then
If V2 Like "ROTES*" _
Or V2 Like "TANKK*" _
Or V2 Like "FREMD*" And V3 Like "L9.5" _
Or V3 Like "L9.6" Then
gesamt.Rows(y).Copy unbetrachtet.Rows(x)
x = x + 1
End If
End If
Next y
With NWB
.SaveAs Environ("UserProfile") & "\Desktop\Nicht betrachtete Datensätze.xls"
End With
With ASH
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, 11)) Then
ASH.Rows(intRow).Delete
End If
Next intRow
End With
End Sub