Hallo zusammen 

Ich bräuchte eure Hilfe bei folgendem Problem. Der Code (s. unten) vergleicht die Zeilen aus Sheet(1), insbesondere Spalte A, E und H. Sind diese gleich werden die Duplikate in Sheet(2) kopiert. (Anzumerken ist, dass ich diesen Code nicht selber geschrieben habe, sondern ein Internet User Names Uwe. Danke Uwe). Soweit so gut. Da ich als VBA Laie leider noch nicht auf deisem Niveau coden kann stellt sich mir jetzt die Frage, wie ich die kopierten Reihen in denen sich Duplikate befinden, nachdem Sie ins Sheet(2) kopiert wurden, automatisch aus Sheet(1) entfernen kann. 

Sub Duplicates()

    Dim ws1 As Worksheet, ws2 As Worksheet, cell As Range, dic As Object
    
    Set ws1 = Sheets(2)
    Set ws2 = Sheets(3)
    
    Set dic = CreateObject("Scripting.Dictionary")
    
    With ws1
        'Überschriften kopieren
        .Range("1:1").Copy ws2.Range("1:1")
        'jede Zeile der Tabelle durchlaufen
        For Each cell In .Range("A2:A" & .UsedRange.SpecialCells(xlCellTypeLastCell).Row)
            'Vergleichstring für Dictionary
            strCompare = cell.Offset(0, 0).Value & "|" & cell.Offset(0, 4).Value & "|" & cell.Offset(0, 7).Value
            
            If Not dic.Exists(strCompare) Then
                'existiert für die Zeile kein Eintrag füge ihn hinzu
                dic.Add strCompare, cell.Address
            Else
                If dic.Item(strCompare) <> "" Then
                    .Range(dic.Item(strCompare)).EntireRow.Copy ws2.Range("A" & ws2.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
                    dic.Item(strCompare) = ""
                   
                End If
                ' Eintrag existiert bereits kopiere Zeile in Zielsheet
                cell.EntireRow.Copy ws2.Range("A" & ws2.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
            End If
        Next

    End With
    
End Sub

Danke für eure Unterstützung! 

LG