Zellen Kopieren und einfügen

Sub Daten()
Dim WbQ As Workbook, WbZ As Workbook, WsQ As Worksheet, wksQ As Worksheet
Dim WsZ As Worksheet, tQ As ListObject, Pfad$
Dim i As Long, letzte As Long, ImportListe As Long
Dim a As Variant
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Bitte einzulesende Datei wählen..."
.AllowMultiSelect = False
If .Show  -1 Then
MsgBox "Vorgang abgebrochen!", vbInformation
Exit Sub
Else: Pfad = .SelectedItems(1)
End If
End With
Application.ScreenUpdating = False
Set WbQ = Workbooks.Open(Pfad)
Set WsQ = WbQ.Worksheets(1)
Set WbZ = Workbooks.Add(template:=xlWBATWorksheet)
Set WsZ = WbZ.Worksheets(1)
Set wksQ = GetObject("C:\Test")
ImportListe = WsZ.Cells(WsZ.Rows.Count, 3).End(xlUp).Row
letzte = WsQ.Cells(WsQ.Rows.Count, 1).End(xlUp).Row
For i = 8 To letzte ' ab Zeile 8
If WsQ.Cells(i, 1).Value Like "Test" Then
WsQ.Cells(i, 2).Copy
WsQ.Cells(i, 8).PasteSpecial
WsZ.Cells(ImportListe + 1, 3).PasteSpecial (xlPasteValuesAndNumberFormats)
End If
Next
Set WbQ = Nothing: Set WbZ = Nothing: Set WsQ = Nothing
Set WsZ = Nothing: Set tQ = Nothing: Set wksQ = Nothing
End Sub