Duplikate kopieren & aus alter Liste löschen
14.02.2014 19:10:14
Judith
ich habe einen totalen Knoten im Kopf und komme einfach nicht weiter. Ich habe eine Datei mit Daten in Tabellenblatt "Data" in Spalte A bis AI, wobei der Wert in Spalte I mehrfach vorkommen kann.
Ich möchte alle Einträge, die in Spalte I den gleichen Wert haben, in das Blatt "Duplicates" kopieren und die Einträge aus dem ursprünglichen Inputblatt "Data" löschen.
Hintergrund ist, dass der Wert in Spalte I zwar der gleiche sein kann, aber ich muss im Nachgang manuell überprüfen, ob es sich tatächlich um den gleichen Vorgang handelt.
Habt ihr vielleicht eine Idee?
Mit folgendem Code habe ich es immerhin geschafft die Einträge in mein Duplicates-Blatt zu kopieren, aber ich bekomme es einfach nicht hin, ALLE Einträge mit dem gleichen Wert in Spalte I zu löschen.
Sub Test()
Dim wstSource As Worksheet, wstOutput As Worksheet
Dim rngCell As Range, rngMyData As Range
Dim lngMyRow As Long
Set wstSource = Worksheets("Data")
Set wstOutput = Worksheets("Duplicates")
Set rngMyData = wstSource.Range("I2:I" & Range("I" & Rows.Count).End(xlUp).Row)
For Each rngCell In rngMyData
If Evaluate("COUNTIF(" & rngMyData.Address & "," & rngCell.Address & ")") > 1 Then
lngMyRow = wstOutput.Cells(Rows.Count, "I").End(xlUp).Row + 1
wstSource.Range("A" & rngCell.Row & ":AI" & rngCell.Row).Copy _
Destination:=wstOutput.Range("A" & lngMyRow & ":AI" & lngMyRow)
End If
Next rngCell
End Sub
Hier auch noch eine Beispieldatei: https://www.herber.de/bbs/user/89294.xlsx
Ich hoffe Ihr könnt mir helfen, denn ich bin mit meinem Latein ziemlich am Ende.
Viele Grüße
Judith