Sub test()
    Dim cell As Range, ra As Range, delra As Range
    Application.ScreenUpdating = False
    Set ra = Range([A1], Range("A" & Rows.Count).End(xlUp))
    For Each cell In ra.Cells
        If WorksheetFunction.CountIf(ra, cell) = 1 Then
            If delra Is Nothing Then Set delra = cell Else Set delra = Union(delra, cell)
        End If
    Next cell
    If delra Is Nothing Then MsgBox "На листе остались только повторяющиеся строки", 64: Exit Sub
    delra.EntireRow.Delete
    Application.ScreenUpdating = True
End Sub