|
trivial
Sub Test()
Dim rng As Range
Dim arr() As Variant
Dim x As Long, fa As String
With ThisWorkbook.Sheets("Tabelle1")
'ab A2 bis erste leere ..
Set rng = .Range(.Cells(2, 1), .Cells(2, 1).End(xlDown))
'inkl. B & C
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
|