Mehrere Spalten Durchsuchen und Ergebnisse in neuer Tabelle Ausgeben

Const SheetQuelle = "Daten"           ' Tabelle Daten/Suchen  
Const SheetZiel = "Vergleich"                      ' Tabelle Suchergebnis  

Const SpalteSuchen = "A:A"                         ' Nutzer:ID  

Const DatenSpalteVon = "A"                        ' Daten kopieren von Spalte  
Const DatenSpalteBis = "V"                         ' Daten kopieren bis Spalte  

Const ZielSpalte = "A"                                   ' Spalte Ziel-Tabelle  
Const ZielZeile = "5"                                     ' ab Zeile Ziel-Tabelle  



Sub Suchen()
    Dim WksQ As Worksheet, WksZ As Worksheet, Suchliste As Variant, Token As Variant, Eingabe As String, SpalteSuchen As Worksheet
    
    Eingabe = InputBox("Bitte Suchbegriffe Komma-Getrennt eingeben:", "Suche")  
    
        If Eingabe = "" Then Exit Sub  
    
        Set WksQ = Sheets(SheetQuelle)
        Set WksZ = Sheets(SheetZiel):  WksZ.Cells.Clear
        
    
        'Überschriftzeile in Ziel-Tabelle schreiben  
        Range(WksQ.Cells(1, DatenSpalteVon), WksQ.Cells(1, DatenSpalteBis)).Copy WksZ.Cells(ZielZeile, ZielSpalte)
    
        Suchliste = Split(Eingabe, ",")  
        
    For Each Token In Suchliste
        If Token <> "" Then Call SearchAndCopy(WksQ, Trim(Token), WksZ)  

    Next
    
        
End Sub


Private Sub SearchAndCopy(ByRef WksQ, ByRef Token, WksZ)
    Dim Found As Range, Suchtext As String, ZeileQ As Long, ZeileZ As Long
    
    With WksQ
        Suchtext = "*" & Token & "*"  'Teilübereinstimmung vor und nach mit "*"  
        If .Range(SpalteSuchen).AutoFilter(Field:=1, Criteria1:=Suchtext, VisibleDropDown:=False) Then
            ZeileQ = WksQ.Cells(WksQ.Rows.Count, "A").End(xlUp).Row  
            ZeileZ = WksZ.Cells(WksZ.Rows.Count, "A").End(xlUp).Row + 1  
            Range(.Cells(2, DatenSpalteVon), .Cells(ZeileQ, DatenSpalteBis)).Copy WksZ.Cells(ZeileZ, ZielSpalte)
        End If
       .AutoFilterMode = False
    End With
End Sub