Sub
Test()
Dim
rng
As
Range
Dim
arr()
As
Variant
Dim
x
As
Long
, fa
As
String
With
ThisWorkbook.Sheets(
"Tabelle1"
)
Set
rng = .Range(.Cells(2, 1), .Cells(2, 1).
End
(xlDown))
Set
rng = rng.Resize(, 3)
arr = rng.Value
End
With
With
Workbooks(
"Kopie von 129819.xlsx"
)
With
.Sheets(
"Tabelle1"
).Columns(1)
For
x = LBound(arr, 1)
To
UBound(arr, 1)
If
arr(x, 3) =
"x"
Then
Set
rng = .Find(arr(x, 1), , xlValues, xlWhole)
If
Not
rng
Is
Nothing
Then
fa = rng.Address
Do
If
rng.Offset(, 1).Value = arr(x, 2)
Then
rng.EntireRow.Copy
Workbooks(
"Kopie von 129819.xlsx"
).Sheets(
"In-dieses-Blatt-Einfügen"
).Cells(Rows.Count, 1).
End
(xlUp).Offset(1).PasteSpecial (xlPasteAll)
Exit
Do
End
If
Loop
While
Not
rng
Is
Nothing
And
rng.Address <> fa
End
If
End
If
Next
x
End
With
End
With
End
Sub