Ersetz doch einfach Thisworkbook.path damit, ist auch nichts anderes als ein relativer Pfad.

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 ASH.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 Environ("UserProfile") & "\Desktop\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