Doppelte Datensätze löschen - erweitern

Sub DoppelteSätzeEliminieren()
Dim i As Long
Sheets("Tabelle1").Activate
'zuerst sortieren
Columns("A:A").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
i = 1
'jetzt doppelte Sätze löschen
Do Until IsEmpty(Cells(i, 1).Value)
If Cells(i, 1).Value = Cells(i + 1, 1).Value Then
Cells(i, 1).EntireRow.Delete
Else
i = i + 1
End If
Loop
End Sub