Versuchs mal so (ungetestete):

Option Explicit

Sub ausschneiden()
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
Dim NWB As Workbook 'neues workbook

    'Zuweisung der Tabellen zu den Variablen
        With ThisWorkbook
            Set ASH = .ActiveSheet
            Set gesamt = .Worksheets("Gesamtauszug")
        End With
        
    'Formeln werden entfernt
        For Each rngZelle In ThisWorkbook.ActiveSheet.UsedRange
            'prüfen ob Zelle eine Formel enthält
                If rngZelle.HasFormula = True Then
                    rngZelle.Rows.Delete
                    lngAnz = lngAnz + 1
                End If
        Next rngZelle
    
    'hier wird die länge der Quelltabelle ermittelt und in die Zieltabelle eingef?gt
        lngZeilen = gesamt.Cells(gesamt.Rows.Count, 1).End(xlUp).Row
        x = 1
    
    '*********************
    '*Workbook hinzufügen*
    '*********************
        Set NWB = Workbooks.Add
        With NWB
            Set unbetrachtet = .Sheets(1)
            .Sheets(1).Name = "unbetrachtete Datensätze"
            Application.DisplayAlerts = False
            .Sheets(2).Delete
            .Sheets(2).Delete
            Application.DisplayAlerts = True
        End With
        
    'Schleife die die Quelltabelle durchsucht und bei bestimmter Bedingung wird die Aktion copy-paste gestartet
        For y = 2 To lngZeilen
            'Bedingungen
                With gesamt
                    V1 = .Cells(y, 10)
                    V2 = .Cells(y, 3).Value
                End With
                If Not V1 Like "W*" _
                Or V2 Like "ROTES*" _
                Or V2 Like "TANKK*" _
                Or V2 Like "EZW*" _
                Or V2 Like "FREMD*" Then
                
                    gesamt.Rows(y).Cut unbetrachtet.Rows(x)
                    x = x + 1
                
                End If
        Next y
    '************************************
    '*neues Workbook speichern/schließen*
    '************************************
        With NWB
            .SaveAs ThisWorkbook.Path & "\Unbetrachtet.xls"
            '.Close (False)
        End With
        
    'hier werden die leeren Zeilen entfernt
        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, 10)) Then
                    .Rows(intRow).Delete
                End If
            Next intRow
        End With

End Sub

Ich hab deine Struktur etwas geändert, um einen besseren Überblick zu haben, kannst du damit etwas anfangen?