Private Sub Worksheet_Activate()
Dim t, dico As New Dictionary, elem, i&, j&, n&
t = Feuil2.Range("a1").CurrentRegion.Value
If IsEmpty(t) Then MsgBox 0 & " ligne supprimée", vbInformation: Exit Sub
If Not IsArray(t) Then ReDim t(1 To 1, 1 To 1): t(1, 1) = Feuil2.Range("a1").Value
If UBound(t) > 0 Then For Each elem In t: dico(CStr(elem)) = "": Next
t = Range("a1").CurrentRegion.Value: n = 1
For i = 2 To UBound(t)
If Not dico.Exists(CStr(t(i, 1))) Then
n = n + 1
For j = 1 To UBound(t, 2): t(n, j) = t(i, j): Next
End If
Next i
Application.ScreenUpdating = False
Range("a1").CurrentRegion.Clear
Range("a1").Resize(n, UBound(t, 2)) = t
MsgBox (UBound(t) - n) & " lignes supprimée(s)", vbInformation
End Sub