Numérotation doublons (vba)

Public Sub OK()
Dim li As Long, obj As Object, k As Long, co As Long, adr As String, nom As String
li = Selection.Row               ' ou calculé autrement
nom = InputBox("nom à traiter")  ' ou calculé autrement
k = 0
With ActiveSheet
  Set obj = .Rows(li).Find(nom, , , xlPart)
  If Not obj Is Nothing Then
    k = k + 1
    co = obj.Column
    .Cells(li, co).Value = nom & " " & k
    adr = obj.Address
    Do
      Set obj = Rows(li).FindNext(obj)
      If Not obj Is Nothing Then
        If obj.Address <> adr Then
          k = k + 1
          co = obj.Column
          .Cells(li, co).Value = nom & " " & k
        End If
      End If
    Loop While Not obj Is Nothing And obj.Address <> adr
  End If
End With
End Sub