Sub extraction()
'extraction chaîne numérique
mycel = ActiveCell.Address
For Each MaCellule In Range(mycel, Range(mycel).End(xlDown))
Set obj = CreateObject("vbscript.regexp")
obj.Global = True
obj.Pattern = "[a-z,A-Z,_]+"
chaine = MaCellule.Value
chaine = obj.Replace(chaine, "")
MaCellule.Offset(, 1) = chaine
Next MaCellule
End Sub