Sub SupprimerLignes()
Dim F1 As Worksheet, F2 As Worksheet, plage As Range
Dim t1, t2, ub%, i&, j%, sup As Boolean, n&
Set F1 = Sheet1 'CodeName de la feuille
Set F2 = Sheet2 'CodeName de la feuille
Set plage = Intersect(F2.UsedRange, F2.[A:G])
If Not plage Is Nothing Then
Application.ScreenUpdating = False
t1 = F1.[A1:G1] 'matrice, plus rapide
t2 = plage 'matrice, plus rapide
ub = UBound(t2, 2)
For i = UBound(t2) To 1 Step -1
sup = True
For j = 1 To ub
If t2(i, j) <> t1(1, j) Then sup = False: Exit For
Next
If sup Then n = n + 1: plage.Rows(i).Delete xlUp
Next
Application.ScreenUpdating = True
End If
MsgBox n & " ligne(s) supprimée(s)", , "Suppression"
End Sub