Doppelte Schlüssel löschen

Sub DeleteDoppelteSchlüssel()
Application.Goto Reference:="AW"
Dim nY     As Long
Dim v      As Variant
Dim r      As Range
On Error GoTo ExitSub
With Application
.ScreenUpdating = False
.EnableEvents = False
Set r = IIf(Selection.Rows.Count > 1, _
Selection, _
ActiveSheet.UsedRange.Rows)
For nY = r.Rows.Count To 1 Step -1
v = r.Cells(nY, 1).Value
If .WorksheetFunction.CountIf(r.Columns(1), v) > 1 Then
r.Rows(nY).Delete
End If
Next nY
ExitSub:
Application.Goto Reference:="MNAME"
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub