Extraire chaine de caractères

Option Explicit
Sub test()
decouper_chiffres_lettres Range("B1").Value, "C4"
End Sub

Sub decouper_chiffres_lettres(Texto, restitution)
Dim Reg As Object
Dim Extraction As Object, Digit As Object
Dim T_chiffres, Idx As Byte, T_pos, T_lettres, Depart As Byte

     Application.ScreenUpdating = False
    Set Reg = CreateObject("vbscript.regexp")
     Reg.Global = True
     Reg.Pattern = "(\d?\d)"
     Texto = Range("B1")
    Set Extraction = Reg.Execute(Texto)
ReDim T_chiffres(Extraction.Count - 1)
ReDim T_pos(Extraction.Count - 1)
    
    For Each Digit In Extraction
        T_pos(Idx) = Digit.Firstindex + 1
        T_chiffres(Idx) = Digit.Value
        Idx = Idx + 1
    Next
    
ReDim T_lettres(UBound(T_pos))
    For Idx = 0 To UBound(T_pos) - 1
          Depart = T_pos(Idx) + Len(T_chiffres(Idx))
          T_lettres(Idx) = Mid(Texto, T_pos(Idx) + Len(T_chiffres(Idx)), T_pos(Idx + 1) - Depart)
    Next
          T_lettres(Idx) = Right(Texto, Len(Texto) - T_pos(Idx) - 1)
     
     Range(restitution).Offset(1, 0).Resize(Extraction.Count, 1) = Application.Transpose(T_chiffres)
     Range(restitution).Offset(0, 1).Resize(1, UBound(T_pos) + 1) = T_lettres
 End Sub