AW: Vergleich von 2 Spalten
14.11.2022 19:37:31
2
na dann mal so vielleicht?
Sub kopierenU1()
Dim rng As Range, i&, lrow&, strRow$, arrrow
i = 1
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Worksheets("Tabelle1")
Do While .Cells(i, "U") ""
'prüfen ob vorhanden
Set rng = Worksheets("Tabelle2").Columns("U").Find(.Cells(i, "U").Value, , xlValues, xlWhole)
If rng Is Nothing Then
'nicht vorhanden
' nächste freie Zeilennummer
If Worksheets("Tabelle3").Cells(1, "U") = "" Then 'sonderfall Tabelle Spalte A leer
lrow = 1
Else
lrow = Worksheets("Tabelle3").Cells(Rows.Count, "U").End(xlUp).Row + 1
End If
.Rows(i).Copy Worksheets("Tabelle3").Rows(lrow) 'zeile kopieren
Application.CutCopyMode = False
strRow = strRow & i & "," 'zeilennummer sammeln
End If
i = i + 1
Loop
If Len(strRow) > 0 Then
arrrow = Split(Left(strRow, Len(strRow) - 1), ",")
For i = UBound(arrrow) To LBound(arrrow) Step -1
.Rows(arrrow(i)).EntireRow.Delete xlShiftUp 'zeilen löschen
Next
End If
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub