ich habe ein Makro welches mir einzelne Einträge kopieren soll, wenn gewissen Kriterien erfüllt sind und sie anschließend in eine neue Tabelle ausgeben soll. Das Kopieren funktioniert problemlos jedoch das einfügen in der neuen Tabelle nicht.
Problem liegt darin, dass nur einen der kopierten Werte in die neue Tabelle eingefügt, er soll aber alle Treffer untereinander einfügen, wer kann mir dabei helfen?
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