supprimer lignes selon une liste de valeurs

Sub supprimer()
lesfeuilles = Array("test", "Feuil1")
Application.ScreenUpdating = False
tablo = Sheets("Feuil2").Range("A2:A" & Sheets("Feuil2").Range("A655536").End(xlUp).Row)
For m = LBound(lesfeuilles) To UBound(lesfeuilles)
 For n = LBound(tablo, 1) To UBound(tablo, 1)
  Set c = Sheets(lesfeuilles(m)).Columns("F").Find(tablo(n, 1), LookIn:=xlValues, lookat:=xlWhole)
  If Not c Is Nothing Then
    Rows(c.Row).Delete
  End If
 Next n
Next m
Application.ScreenUpdating = True
End Sub

Sub supLignesRapide()
  Application.ScreenUpdating = False
  sup = Sheets("feuil2").[C2]
  a = Range("f2:f" & [f65000].End(xlUp).Row)
  For i = LBound(a) To UBound(a)
    If InStr(sup, a(i, 1)) = 0 Then a(i, 1) = 0 Else a(i, 1) = "sup"
  Next i
  Columns("b:b").Insert Shift:=xlToRight
  [B2].Resize(UBound(a)) = a
  [A2].CurrentRegion.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess
  On Error Resume Next
  Range("B2:B65000").SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
  Columns("b:b").Delete Shift:=xlToLeft
End Sub