Attribute VB_Name = "Filter"
Sub Filter_double_entries()

For i = 1 To 1000
        If Range("A" & i) = Range("A" & i + 1) Then
            Range("A" & i & ":ZZ" & i) = ""
        End If
Next i

'Lerrzeilen löschen
Application.ScreenUpdating = False
Range("A1:A65536").SpecialCells(xlCellTypeBlanks). _
EntireRow.Delete

End Sub