Bonjour,
Essaie ceci sur une copie de ton fichier (pas l'original).
Cdlt.
Option Explicit
' Supprime les lignes identiques d'une base données
' Warning ! Restitue les données en lieu et place des données existantes
Public Sub DeleteDuplicates()
Dim ws As Worksheet
Dim Dict As Object
Dim a, b()
Dim x As String
Dim I As Long, J As Long
Dim k As Long, m As Long
Set ws = ActiveSheet
a = ws.Cells(1).CurrentRegion.Value
Set Dict = CreateObject("scripting.dictionary")
'Dict.CompareMode = vbTextCompare
For I = 1 To UBound(a, 1)
x = ""
For J = 1 To UBound(a, 2): x = x & a(I, J): Next J
Dict(x) = ""
Next I
ReDim b(1 To Dict.Count, 1 To UBound(a, 2))
Set Dict = CreateObject("scripting.dictionary")
'Dict.CompareMode = vbTextCompare
m = 0
For I = 1 To UBound(a, 1)
x = ""
For J = 1 To UBound(a, 2): x = x & a(I, J): Next J
If Not Dict.exists(x) Then
m = m + 1
For k = 1 To UBound(a, 2): b(m, k) = a(I, k): Next k
Dict(x) = ""
End If
Next I
Application.ScreenUpdating = False
With ws.Cells(1)
.CurrentRegion.ClearContents
.Resize(UBound(b), UBound(b, 2)) = b
End With
Set Dict = Nothing: Set ws = Nothing
End Sub