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