Sub Trier()
Dim tablo, zero(), i&, t, n As Byte, j As Byte
tablo = [A1].CurrentRegion.Columns(1)
ReDim zero(1 To UBound(tablo), 1 To 2)
For i = 1 To UBound(tablo)
t = tablo(i, 1)
n = 0
For j = 1 To Len(t) 'repérage des nombres
If IsNumeric(Mid(t, j, 1)) Then
While IsNumeric(Mid(t, n + j, 1))
n = n + 1
Wend
Exit For
End If
Next
zero(i, 1) = j: zero(i, 2) = 10 - n 'caractéristiques des zéros insérés
tablo(i, 1) = Application.Replace(t, j, 0, String(10 - n, "0")) 'insertion des zéros
Next
Application.ScreenUpdating = False
[A1].CurrentRegion.Columns(1) = tablo
[A:A].Insert '2 colonnes auxiliaires
[A:A].Insert
[A1].Resize(UBound(zero), 2) = zero
[A1].CurrentRegion.Sort [C1], Header:=xlYes 'tri
tablo = [A1].CurrentRegion
For i = 1 To UBound(tablo) 'suppression des zéros
tablo(i, 3) = Application.Replace(tablo(i, 3), tablo(i, 1), tablo(i, 2), "")
Next
[A1].CurrentRegion = tablo
[A:B].Delete
End Sub