Derniers caractères en rouge si Numeric

Dim Cellule As Range, Chaîne As String, I As Integer
For Each Cellule In Selection
Chaîne = Cellule.Value
For I = 1 To Len(Chaîne)
If IsNumeric(Mid(Chaîne, I, 1)) Then Exit For
Next I
With Cellule.Characters(Start:=1, Length:=I - 1).Font
    .ColorIndex = xlAutomatic
End With
With Cellule.Characters(Start:=I, Length:=Len(Chaîne) - I + 1).Font
    .ColorIndex = 3
End With
Next

For Each Cellule In Range("A2:A" & Range("A65536").End(xlUp).Row)

Sub Macro1()

maligne = Range("A65536").End(xlUp).Row
For x = 1 To maligne
    y = Len(Range("A" & x))
    For z = y To 1 Step -1
        If Not IsNumeric(Mid(Range("A" & x), z, 1)) Then Exit For
    Next
    If z <> y Then Range("A" & x).Characters(Start:=z + 1, Length:=y - z).Font.ColorIndex = 3
Next
End Sub

Dim Cellule As Range, Chaîne As String, I As Integer
For Each Cellule In Selection
Chaîne = Cellule.Value
For I = 1 To Len(Chaîne) [COLOR=seagreen]' Len donne le nombre de caractères de la chaîne[/COLOR]
If IsNumeric(Mid(Chaîne, I, 1)) Then Exit For [COLOR=seagreen]' Mid extrait de la chaîne en fonction de la position et du nombre de caractères souhaités
[/COLOR]Next I
With Cellule.Characters(Start:=1, Length:=I - 1).Font [COLOR=seagreen]' Sélectionne les caractères que l'on veut en noir
[/COLOR]    .ColorIndex = xlAutomatic
End With
With Cellule.Characters(Start:=I, Length:=Len(Chaîne) - I + 1).Font [COLOR=seagreen]' Sélectionne ceux qu'on veux en rouge[/COLOR]
    .ColorIndex = 3
End With
Next

Dim Cellule As Range, Chaîne As String, I As Integer
For Each Cellule In Range("A2:A" & Range("A65536").End(xlUp).Row)
  Chaîne = Cellule.Value
  For I = 1 To Len(Chaîne) ' Len donne le nombre de caractères de la chaîne
    If IsNumeric(Mid(Chaîne, I, 1)) Then Exit For ' Mid extrait de la chaîne en fonction de la position et du nombre de caractères souhaités
  Next I
  If I <= Len(Chaîne) Then Cellule.Characters(I).Font.ColorIndex = 3 ' colorie les nombres éventuels en rouge
Next Cellule