Afficher doublon essentiellement

Option Explicit 'oblige à déclarer toutes les variables
Sub toto()
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim x As Byte 'déclare la variable x (incrément de variable)
Dim tb() As Integer 'déclare le tableau de variables tb (TaBleau)
Dim y As Integer 'déclare la variable y (incrément de varriable)
 
Set pl = Range("A2:A" & Range("A65536").End(xlUp).Row) 'définit la plage pl
 
'********************************************
'première variable du tableau de variables tb
'********************************************
For Each cel In pl 'boucle 1 : sur toutes les cellules cel de la plage pl
    'condition : si la valeur de la cellule cel existe plus d'une fois dans la plage pl
    If Application.WorksheetFunction.CountIf(pl, cel.Value) > 1 Then
        ReDim Preserve tb(x) 'redimensionne le tableau tb
        tb(x) = cel.Value 'attribue la première variable
        cel.Offset(0, 1).Value = cel.Value 'copie la valeur de cel en colonne B
        Exit For 'sort de la boucle
    End If 'fin de la condition
Next cel 'prochaine cellule de la boucle 1
 
'*******************************************
'autres variables du tableau de variables tb
'*******************************************
For Each cel In pl 'boucle 1 : sur toutes les cellules cel de la plage pl
    'condition : si la valeur de la cellule cel existe plus d'une fois dans la plage pl
    If Application.WorksheetFunction.CountIf(pl, cel.Value) > 1 Then
        For y = 0 To UBound(tb) 'boucle 2 : sur toutes les variables indexées du tableau tb
            'si la valeur de la cellule est égale à la variable indexée de tb, va à l'étiquette "suite" (sans ajout de variables)
            If cel.Value = tb(y) Then GoTo suite
        Next y 'prochaine variable indexée de la boucle 2
 
        cel.Offset(0, 1).Value = cel.Value 'copie la valeur de cel en colonne B
        x = x + 1 'incrémente la variable x
        ReDim Preserve tb(x) 'redimensionne le tableau de variable tb
        tb(x) = cel.Value 'ajoute une nouvelle variable indexée au tableau tb
    End If 'fin de la condition
 
suite: 'étiquette
Next cel 'prochaine cellule de la boucle 1
End Sub

  For i = [A65000].End(xlUp).Row To 2 Step -1
    If Cells(i, 1) <> Cells(i - 1, 1) And Application.CountIf([a:a], Cells(i, 1)) > 1 Then Cells(i, 2) = Cells(i, 1)
  Next i

=SI(OU(NB.SI(A2:A9;A2)=1;NB.SI(A$2:A2;B1)>0);"";A2)

=SI(NB.SI(A2:$A$9;A2)>1;A2;"")

=SI(ET(NB.SI($A:$A;A2)>1;NB.SI($A$2:A2;A2)=1);A2;"")