Hallo zusammen,
habs bisher nur hinbekommen, die im Tabellenblatt Liste gefundenen Werte einmal neben dem Suchwert im Tabellenblatt Abgleich zu kopieren, würde aber gern alle Ergebnisse unter dem Suchwert als jeweils neuen Zeileneintrag einfügen. Hat jemand eine Idee? Vielen Dank vorab fürs grübeln.
Sub AbgleichListe()
Dim Wks As Worksheet
Dim x As Range
Dim Finden As Range
Dim EndLine As Long
Sheets("Abgleich").Activate
Set Wks = Sheets("Liste")
EndLine = Cells(Rows.Count, "B").End(xlUp).Row
For Each x In Range("B2:B" & EndLine)
Set Finden = Wks.Columns("a").Find(x, LookIn:=xlValues, LookAt:=xlWhole)
If Not Finden Is Nothing Then
'Wenn in der Found-Zeile (Found=Range) Spalte A-G kopieren und in Tabelle Abgleich in Spalte C in aktueller Zeile einfügen
Range(Wks.Cells(Finden.Row, "A"), Wks.Cells(Finden.Row, "G")).Copy Destination:=Cells(x.Row, "c")
End If
Next
End Sub
|