Bonjour à toutes et tous et plus particulièrement à R@chid de la famille des fabacées
Pour le fun...
Bonne journée.
Option Explicit
Sub Suppression_doublons()
Dim t As Single
Dim Ws As Worksheet
Dim Plage, c()
Dim monDico
Dim Ligne As Long, i As Long, k As Long
Dim tmp As String
t = Timer()
Application.ScreenUpdating = False
'-------------------------------------------------------------------
Set Ws = Worksheets("Feuil1")
Plage = Ws.Range("A1").CurrentRegion.Value
ReDim c(1 To UBound(Plage, 1), 1 To UBound(Plage, 2))
Set monDico = CreateObject("Scripting.Dictionary")
'-------------------------------------------------------------------
Ligne = 1
For i = 1 To UBound(Plage)
tmp = ""
For k = 1 To UBound(Plage, 2)
tmp = tmp & Plage(i, k)
Next
If Not monDico.exists(tmp) Then
monDico.Add tmp, 1
For k = 1 To UBound(Plage, 2)
c(Ligne, k) = Plage(i, k)
Next k
Ligne = Ligne + 1
End If
Next
'-------------------------------------------------------------------
With Ws.[O1]
.Resize(monDico.Count, UBound(Plage, 2)) = c
.Sort Key1:=[O2], Order1:=xlAscending, Header:=xlYes
End With
'-------------------------------------------------------------------
Application.ScreenUpdating = True
MsgBox Timer() - t & " seconde(s)"
End Sub