Cellule identique / itération

Public Function Nettoie(s As String) As String
If Not IsNumeric(Right(s, 1)) Then
  Nettoie = s
Else
  Nettoie = Nettoie(Left(s, Len(s) - 1))
End If
End Function

Public Sub Ok()
Dim plage As Range, cel As Range
Dim obn As Object, cle As String, cles, k As Long, n As Long, numnom As Long, nom As String
Set plage = Selection
' nettoyer plage
For Each cel In plage
  cel.Value = Nettoie(cel.Value)
Next cel
' numerotage
Set obn = CreateObject("scripting.dictionary")
For Each cel In plage
  cle = cel.Value
  If Not obn.exists(cle) Then obn.Add cle, 1
Next cel
cles = obn.keys
n = obn.Count
For k = 0 To n - 1
  nom = cles(k)
  numnom = 0
  For Each cel In plage
    If cel.Value = nom Then
      numnom = numnom + 1
      cel.Value = nom & numnom
    End If
  Next cel
Next k
End Sub