Option Explicit
Option Base 1
 
Sub SupprimeDoublons()
    Dim Plage As Range, Cell As Range
    Dim Un As New Collection
    Dim Tableau() As Integer
    Dim x As Integer
    Dim Derncol As Long
    Dim DernLigne As Long
    Dim col As Integer
    Derncol = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
    For col = 1 To Derncol
 
    'Définit la plage de cellules pour la recherche de doublons
    DernLigne = Cells(Rows.Count, col).End(xlUp).Row
    Set Plage = Worksheets("Feuil1").Range(Cells(1, col), Cells(DernLigne, col))
 
    On Error Resume Next
    'Boucle sur les cellules de la plage cible
    For Each Cell In Plage
        'Création d'une collection de données uniques (sans doublons)
        Un.Add Cell, CStr(Cell)
 
        'Une erreur survient si l'élément existe dans la collection.
        'La procédure enregistre le numéro de ligne correspondant dans un tableau.
        If Err.Number <> 0 Then
            x = x + 1
            ReDim Preserve Tableau(1 To x)
            Tableau(x) = Cell.Row
            Err.Clear
        End If
    Next Cell
    On Error GoTo 0
 
    'On sort si aucun doublon n'a été trouvé.
    If x = 0 Then Exit Sub
 
    'Fige l'écran pendant la suppression des lignes
    Application.ScreenUpdating = False
 
    'Boucle sur le tableau pour supprimer les lignes contenant des doublons.
    For x = UBound(Tableau) To LBound(Tableau) Step -1
        Worksheets("Feuil1").Rows(Tableau(x)).Cells.Delete
    Next x
 
    Application.ScreenUpdating = True
    Next col
End Sub