Option
Explicit
Sub
test()
Dim
rngHeadings
As
Excel.Range
Dim
rngHeading
As
Excel.Range
Dim
rngResult
As
Excel.Range
With
Tabelle1
Set
rngHeadings = .Range(.Range(
"A1"
), .Cells(.Rows.Count,
"A"
).
End
(xlUp))
End
With
For
Each
rngHeading
In
rngHeadings
With
Tabelle2
Set
rngResult = .Rows(1).Find(rngHeading.Text, LookIn:=xlValues, LookAt:=xlWhole)
If
Not
rngResult
Is
Nothing
Then
Set
rngResult = .Range(rngResult, .Cells(.Rows.Count, rngResult.Column).
End
(xlUp))
Call
rngResult.Copy(Destination:=<...>)
End
If
End
With
Next
End
Sub