Compter automaiquement en fonction d'un nom

Sub Test()
Dim I As Long, J As Byte, K As Byte
I = 1
While Range("A" & I + 1) <> ""
If Range("A" & I) = Range("A" & I + 1) And Right(Range("A" & I + 1), 2) = "_1" Then
J = 1
While Range("A" & I) = Range("A" & I + J)
J = J + 1
Wend
For K = 1 To J - 1
Range("A" & I + K) = Left(Range("A" & I + K), Len(Range("A" & I + K)) - 1) & K + 1
Next K
End If
I = I + 1
Wend
End Sub