Option Explicit
Sub NumberTraker()
Dim Cell As Range
Dim i As Byte
Dim StringTmp As String, StringNum1 As String
Dim Num As Boolean, Stopped As Boolean
Dim Container As Variant
For Each Cell In Range('A1:A100') ''A Spécifier ....
If Not Cell = '' Then
Num = False
Stopped = False
StringTmp = ''
StringNum1 = ''
For i = 1 To Len(Cell)
If IsNumeric(Mid(Cell, i, 1)) Then
If Not Stopped Then
StringNum1 = StringNum1 & Mid(Cell, i, 1)
Num = True
End If
Else
If Num = True Then
StringTmp = StringTmp & Mid(Cell, i, 1)
Stopped = True
End If
End If
Next
Container = Split(Cell.Text, StringTmp)
Cell.Offset(0, 1) = StringNum1
With Cell.Offset(0, 2)
.NumberFormat = '0000'
.Value = Container(1)
End With
End If
Next
End Sub
