aider moi à trier un file excel plus de 30000 lignes

Option Explicit

Sub SupprimerLignesDoublons()
'http://www.excel-downloads.com/html/French/forum/messages/1_65560_65560.htm
'suppression ligne si toutes les cellules de la ligne forment un doublon
'michel
'le 14.01.2004
Dim Cell As Range
Dim Ligne As Integer, i As Integer
Dim M As Byte, j As Byte, N As Byte
Dim Tableau(), Tableau2()
Dim Cible As String, Resultat As String
Dim U As Boolean

Ligne = Range("A65536").End(xlUp).Row ' derniere ligne non vide colonne A
M = 1
N = 1
ReDim Preserve Tableau(M) 'tableau valeurs uniques colonne A
ReDim Preserve Tableau2(N) ' tableau pour numero de lignes doublons

Application.ScreenUpdating = False
For Each Cell In Range("A1:A" & Ligne)
U = False
Cible = Cell
For j = 1 To 6 ' adapter selon nombre de colonnes pour chaque
Cible = Cible & Cell.Offset(0, j)
Next j
For i = 1 To M
If Cible = Tableau(i - 1) Then '
Tableau2(N - 1) = Cell.Row ' recupere numero de ligne quand un doublon est detecté
N = N + 1
ReDim Preserve Tableau2(N)
U = True
End If
Next i

If Tableau(M - 1) = "" And U = False Then
Tableau(M - 1) = Cible ' remplissage tableau valeurs uniques si pas de doublon détecté
M = M + 1
ReDim Preserve Tableau(M)
End If
Next Cell

For i = N - 1 To 1 Step -1 ' boucle pour supprimer les lignes de doublons
Rows(Tableau2(i - 1)).Delete
Next i
Application.ScreenUpdating = True

End Sub

Option Explicit

Sub SupprimerLignesDoublons()
'http://www.excel-downloads.com/html/French/forum/messages/1_65560_65560.htm
'suppression ligne si toutes les cellules de la ligne forment un doublon
'michel
'le 14.01.2004
Dim Cell As Range
Dim Ligne As Long, i As Integer

Sub es()
Dim t As Variant, t2() As Variant, x As Long, i As Long, k As Long, M As Object
On Error Resume Next
Application.ScreenUpdating = False
Set M = CreateObject("Scripting.Dictionary")
t = Range("a2:p" & Cells(Rows.Count, 1).End(xlUp).Row)
x = 1
For i = 1 To UBound(t)
t(i, 16) = t(i, 1) & t(i, 2) & t(i, 3) & t(i, 4) & t(i, 5) & t(i, 6) & t(i, 7) & t(i, 8) _
& t(i, 9) & t(i, 10) & t(i, 11) & t(i, 12) & t(i, 13) & t(i, 14) & t(i, 15)
If Not M.Exists(t(i, 16)) Then
M.Add t(i, 16), t(i, 16)
ReDim Preserve t2(1 To 15, 1 To x)
For k = 1 To 15: t2(k, x) = (t(i, k)): Next k: x = x + 1: End If: Next i
Range("a2:o" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
Range("a2").Resize(UBound(t2, 2), UBound(t2, 1)) = Application.Transpose(t2)
Erase t, t2: Set M = Nothing
End Sub