Public Sub Kopieren()
Dim loLetzteQ As Long, loLetzteZ As Long
Application.ScreenUpdating = False
With Worksheets("Tabelle2")
.Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).Copy
With Worksheets("Tabelle1")
.Range("E" & .Cells(.Rows.Count, "E").End(xlUp).Offset(1).Row).PasteSpecial Paste:=xlPasteValues
.Range("F2:F" & .Cells(.Rows.Count, "E").End(xlUp).Row).FormulaLocal = "=ZEILE()"
.Range("F2:F" & .Cells(.Rows.Count, "E").End(xlUp).Row).Value = .Range("F2:F" & .Cells(.Rows.Count, "E").End(xlUp).Row).Value
End With
End With
With Worksheets("Tabelle3")
.Range("B2:B" & .Cells(.Rows.Count, "A").End(xlUp).Row).FormulaLocal = "=WENN(ZÄHLENWENN(Tabelle2!$A:$A;Tabelle1!A2)>0;""x"";ZEILE())"
.Range("A2:B" & .Cells(.Rows.Count, "A").End(xlUp).Row).Copy
With Worksheets("Tabelle1")
.Range("E" & .Cells(.Rows.Count, "E").End(xlUp).Offset(1).Row).PasteSpecial Paste:=xlPasteAll
.Range("F1") = "x"
.Columns("E:F").RemoveDuplicates Columns:=2, Header:=xlNo
Application.CutCopyMode = False
.Range("E:F").RemoveDuplicates Columns:=2, Header:=xlNo
.Range("F1").ClearContents
.Columns("F").ClearContents
End With
.Columns(2).ClearContents
End With
Application.CutCopyMode = False
End Sub