Sub SupprimerLignes()
Dim tablo, d As Object, i&, x$, tablo1()
With Sheets("Utilisateurs") 'nom modifiable
tablo = .Range("A1", .UsedRange).Columns("I:J") 'matrice, plus rapide, au moins 2 éléments
End With
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For i = 1 To UBound(tablo)
x = CStr(tablo(i, 1))
If x <> "" Then d(x) = "" 'liste sans doublon
Next i
Application.ScreenUpdating = False
With Sheets("BD") 'nom modifiable
If .FilterMode Then .ShowAllData 'si la feuille est filtrée
.Columns(1).Insert 'insère une colonne auxiliaire
With .Range("A1", .UsedRange)
tablo = .Columns("K:L") 'matrice, plus rapide, au moins 2 éléments (colonnes J:K à l'origine)
ReDim tablo1(1 To UBound(tablo), 1 To 1)
For i = 1 To UBound(tablo)
tablo1(i, 1) = IIf(d.exists(CStr(tablo(i, 1))), "a", 1)
Next i
.Columns(1) = tablo1
.Sort .Columns(1), xlAscending, Header:=xlNo 'tri pour regrouper et accélérer
On Error Resume Next 'si aucune SpecialCell
.Columns(1).SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete 'supprime les valeurs textes
End With
.Columns(1).Delete 'supprime la colonne auxiliaire
With .UsedRange: End With 'actualise les barres de défilement
End With
End Sub