Sub Extraire()
Dim tablo, i&, x$, deb%, n%, z$, j%, y$
tablo = [A1].CurrentRegion.Resize(, 24) 'matrice, plus rapide, au moins 2 éléments
For i = 1 To UBound(tablo)
x = tablo(i, 24) 'colonne X
deb = 0: n = 0: z = ""
For j = 1 To Len(x) + 1
y = Mid(x, j, 1)
If deb = 0 Then If IsNumeric(y) And n < 3 Then n = n + 1: deb = j 'limite de 3 nombres
If deb Then If Not IsNumeric(y) Then z = z & Chr(1) & Mid(x, deb, j - deb): deb = 0
Next j
tablo(i, 1) = Mid(z, 2)
Next i
'---restitution---
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With [Y1].Resize(i - 1) '1ère colonne de restitution
tablo(1, 1) = .Cells(1, 1) & Chr(1) & .Cells(1, 2) & Chr(1) & .Cells(1, 3) 'titres
.Value = tablo
.TextToColumns .Cells, xlDelimited, Other:=True, OtherChar:=Chr(1) 'commande Convertir
End With
End Sub