Sub es()
Dim t As Variant, t2(), m As Object, x As Long, i As Long, k As Long, c As Range
Application.ScreenUpdating = False
On Error Resume Next
Set m = CreateObject("Scripting.Dictionary")
t = Range("a2:e" & Cells(Rows.Count, 1).End(xlUp).Row)
x = 1: For i = 1 To UBound(t)
If Not m.Exists(t(i, 1)) Then
m.Add t(i, 1), t(i, 1): ReDim Preserve t2(1 To 4, 1 To x)
For k = 1 To 4: t2(k, x) = (t(i, k)): Next k: x = x + 1: End If: Next i
Range("a2:d" & Cells.Find("*", , , , , xlPrevious).Row).ClearContents
Range("a2").Resize(UBound(t2, 2), UBound(t2, 1)) = Application.Transpose(t2)
Erase t, t2: Set m = Nothing
For Each c In Range("a2", Cells(Rows.Count, "a").End(xlUp))
c = StrReverse(c)
Next
[a2:d65536].Sort Key1:=Range("a2"), Order1:=xlAscending, Header:=xlGuess
For Each c In Range("a2", Cells(Rows.Count, "a").End(xlUp))
c = StrReverse(c)
Next
End Sub