Option Compare Text 'si l'on veut que la casse soit ignorée
Sub Numéroter()
Dim P As Range, Nlig%, Ncol%, i%, j%, n%, n1%, n2%, i1%, j1%
Set P = [D2:S39]
Nlig = P.Rows.Count: Ncol = P.Columns.Count
Application.ScreenUpdating = False
'---RAZ---
For i = Nlig * 6 To 1 Step -1
For j = 1 To Ncol Step 3
P.Columns(j).Replace " " & i, "", xlPart
Next
Next
'Exit Sub 'pour présentation sans numéros
'---affectation des numéros---
For j = 1 To Ncol Step 3
For i = 1 To Nlig
If P(i, j) <> "" Then
n = n + 1 'numéro de repérage
n1 = 0: n2 = 0 'n1 numéro de repérage, n2 comptage des noms identiques
For j1 = 1 To Ncol Step 3
For i1 = 1 To Nlig
If P(i1, j1) <> "" Then
n1 = n1 + 1
If Trim(P(i1, j1)) Like Trim(P(i, j)) & "*" Then n2 = n2 + 1
If n1 = n Then P(i, j) = Trim(P(i, j)) & " " & n2: GoTo 1
End If
Next i1
Next j1
End If
1 Next i
Next j
End Sub