XL 2021 classer par nom mais en regardant les 18 dernieres lettre

Sub trier()
Dim der, t, i&, n&
   Application.ScreenUpdating = False
   der = Cells(Rows.Count, 1).End(xlUp).Row
   t = Range("a1:a" & der)
   For i = 1 To UBound(t): t(i, 1) = Right(t(i, 1), 18) & ">" & t(i, 1): Next
   Range("a1:a" & der) = t
   Range("a1:a" & der).Sort key1:=Range("a1"), order1:=xlAscending, Header:=xlNo
   t = Range("a1:a" & der)
   For i = 1 To UBound(t)
      n = InStrRev(t(i, 1), ">")
      If n Then t(i, 1) = Mid(t(i, 1), n + 1)
   Next
   Range("a1:a" & der) = t
End Sub

Sub test()
    Dim Tblo, A&, B&, Temp$
    tablo = [A1].Resize(ActiveSheet.UsedRange.Rows.Count)
    MsgBox UBound(tablo)
    For A = 1 To UBound(tablo)
        For B = 1 To UBound(tablo)
            If Val(Mid(tablo(A, 1), Len(tablo(A, 1)) - 17)) < Val(Mid(tablo(B, 1), Len(tablo(B, 1)) - 17)) Then
                Temp = tablo(A, 1): tablo(A, 1) = tablo(B, 1): tablo(B, 1) = Temp
            End If
        Next
    Next
    [h1].Resize(UBound(tablo)) = tablo
End Sub