XL 2013 Ajouter un caractère à un doublon VBA

Sub doublons()
Dim t, d, i&, x
   With ActiveSheet
      If .FilterMode Then .ShowAllData
      t = .Cells(1, "a").Resize(.Cells(.Rows.Count, "a").End(xlUp).Row)
      Set d = CreateObject("scripting.dictionary")
      For i = 1 To UBound(t)
         x = Replace(t(i, 1), "*", "")
         If Not d.exists(x) Then d.Add x, "" Else t(i, 1) = x & "*"
      Next i
      .Cells(1, "a").Resize(ubound(t)) = t
   End With
End Sub

Sub Afficher()
    Dim Cell As Range
    Dim Collec As New Collection
    With Sheets("Feuil1")
            For Each Cell In .Range("A1:A" & .Range("A65536").End(xlUp).Row)
                On Error Resume Next
                    Collec.Add Cell, CStr(Cell)
                    If Err <> 0 Then
                        Cell.Value = Cell & " *"
                        Err = 0
                    End If
                On Error GoTo 0
            Next
    End With
End Sub

Sub Afficher()
    Dim Cell As Range
    Dim Collec As New Collection
    With Sheets("Feuil1")
            For Each Cell In .Range("A1:A" & .Range("A65536").End(xlUp).Row)
                On Error Resume Next
                    Collec.Add replace(Cell,"*",""), CStr(replace(Cell,"*",""))
                    If Err <> 0 Then
                        Cell.Value = Cell & " *"
                        Err = 0
                    End If
                On Error GoTo 0
            Next
    End With
End Sub

Sub Afficher()
    Static TbL
    Dim plage As Range, Collec As New Collection, NbErreur As Byte, I&
    Set plage = [Feuil1!A1].Resize([Feuil1!A65535].End(xlUp).Row)
      TbL = plage.Value
            For I = 1 To UBound(TbL)
                On Error Resume Next
                    Collec.Add CStr(TbL(I)), CStr(TbL(I))
                    If Err <> 0 Then
                        TbL(I) = TbL(I) & " *"
                        Err.Clear
                        NbErreur = NbErreur + 1
                    End If
                On Error GoTo 0
            Next
    plage.Value = TbL'mise a jour le 1 ere passe
    'If NbErreur > 0 Then'déclenche une insuffisance de memoire
       ' Afficher
    'End If
[Feuil1!B1].Resize(UBound(TbL)) = TbL

End Sub

Sub NumDoublons()
Dim t, d, i&, x, n&
   With ActiveSheet
      If .FilterMode Then .ShowAllData
      t = .Cells(1, "a").Resize(.Cells(.Rows.Count, "a").End(xlUp).Row)
      Set d = CreateObject("scripting.dictionary")
      For i = 1 To UBound(t)
         t(i, 1) = Trim(t(i, 1))
         n = InStr(t(i, 1), " (")
         If n > 0 Then t(i, 1) = Trim(Left(t(i, 1), n - 1))
         If Not d.exists(t(i, 1)) Then
            d.Add t(i, 1), 1
         Else
            n = d(t(i, 1)) + 1: d(t(i, 1)) = n
            t(i, 1) = t(i, 1) & " *" & Space(3 - Len(CStr(n))) & n
         End If
      Next i
      .Cells(1, "a").Resize(UBound(t)) = t
   End With
End Sub