Séparer chiffres et lettres et en supprimer certains

Option Explicit
'------- --------
Sub separer_nombre_texte()
Dim texto As String, Lig As Integer, Derlig As Integer

Application.ScreenUpdating=false
With ActiveSheet
    Derlig = .Columns("A").Find(what:="*", searchdirection:=xlPrevious).Row
    For Lig = 1 To Derlig
        texto = .Cells(Lig, "A")
        .Cells(Lig, "B") = Right(extrait_chiffres(texto), 2) & " " & extrait_lettres(texto)
    Next
End With
End Sub
'--------------
Function extrait_chiffres(ByRef texto As String) As Long
    Dim reg As Object
    Dim extraction As Object
    Dim Digit
    
    Set reg = CreateObject("vbscript.regexp")
    'on travaille sur toute la cellule
    reg.Global = True
    'le modèle est des caractères "digitaux ("d") à n chiffres (d?\)
    reg.Pattern = "(\d)"
        ' éxécute l'extraction svt modèle (collection des digits...)
    Set extraction = reg.Execute(texto)
    For Each Digit In extraction
        ' concaténète les membres de la collection "extraction"
        extrait_chiffres = extrait_chiffres & (Digit.Value)
    Next Digit
    Set extraction = Nothing
    Set reg = Nothing
End Function
'-------
Function extrait_lettres(ByRef texto As String) As String
Dim reg As Object
Dim extraction As Object
Dim Digit
    Set reg = CreateObject("vbscript.regexp")
    reg.Global = True
    reg.Pattern = "(\D)"
    Set extraction = reg.Execute(texto)
    For Each Digit In extraction
        extrait_lettres = extrait_lettres & (Digit.Value)
    Next Digit
    Set extraction = Nothing
    Set reg = Nothing
End Function