les doublons dans une plage de cellules

Option Explicit

Sub Macro1()
    Dim nbRows As Long
    Dim nbCols As Integer
    Dim x As Integer, y As Long
    Dim nbCells As Long
    Dim Pointeur As Long
    
    ' On copie la feuille1 dans la feuille 2
    Cells.Select
    Range("A20").Activate
    Selection.Copy
    Sheets("Feuil2").Select
    Cells.Select
    ActiveSheet.Paste
    Worksheets("Feuil2").Select
    
    ' On calcule le nombre de colonnes du tableau
    nbCols = ActiveSheet.UsedRange.Columns.Count
    
    ' On recopie les colonnes 2 à nbcols dans la colonne 1
    For x = 2 To nbCols
        Pointeur = Cells(Rows.Count, 1).End(xlUp).Row
        nbCells = Cells(Rows.Count, x).End(xlUp).Row + 1
        For y = 1 To nbCells
            Cells(y + Pointeur, 1) = Cells(y, x)
        Next y
    Next x
    
    ' On supprime les cellules vides s'il y en a
    Pointeur = Cells(Rows.Count, 1).End(xlUp).Row
    For y = Pointeur To 1 Step -1
        If Cells(y, 1) = "" Then
            Rows(y).Select
            Selection.Delete Shift:=xlUp
        End If
    Next y
    
    ' On ne garde que la colonne 1
    For x = nbCols To 2 Step -1
        Columns(x).Select
        Selection.Delete Shift:=xlToLeft
    Next x
    
    ' On trie la feuille sur la colonne 1
    Cells.Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

    ' et on détruit les lignes contenant des valeurs non répétées
    For y = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
        If Cells(y, 1) = Cells(y - 1, 1) Or Cells(y, 1) = Cells(y + 1, 1) Then
        Else
            Rows(y).Select
            Selection.Delete Shift:=xlUp
        End If
    Next y
    
    If Cells(1, 1) <> Cells(2, 1) Then
        Rows(1).Select
        Selection.Delete Shift:=xlUp
    End If
    ' Il ne reste que les doublons
End Sub