XL 2013 Filtre avec plusieurs mots clefs

Sub FiltreInverseListe()
  Set f = Sheets("feuil1")
  Set d = CreateObject("scripting.dictionary")     ' Liste à ne pas sélectionner
  d.CompareMode = vbTextCompare
  For Each c In f.Range("E2:E" & f.[E65000].End(xlUp).Row)
    d(c.Value) = ""
  Next c
  Set d2 = CreateObject("scripting.dictionary")    ' liste complémentaire
  d2.CompareMode = vbTextCompare
  For Each c In f.Range("A2:A" & f.[A65000].End(xlUp).Row)
   If Not d.exists(c.Value) Then d2(c.Value) = ""
  Next c
  ActiveSheet.Range("$A$1:$A$10000").AutoFilter Field:=1, Criteria1:=d2.keys, Operator:=xlFilterValues
End Sub

Sub FiltreInverseListe()
    Range("A1:A10000").AdvancedFilter Action:=xlFilterInPlace, _
       CriteriaRange:=Range("C1:C2"), Unique:=False
End Sub

Sub lister()
Dim tablo, exclu, d As Object, i&, s, j%, n&
tablo = [A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
exclu = [D1].CurrentRegion.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For i = 2 To UBound(exclu): d(exclu(i, 1)) = "": Next
For i = 2 To UBound(tablo)
    s = Split(tablo(i, 1))
    For j = 0 To UBound(s)
        If d.exists(s(j)) Then GoTo 1
    Next
    n = n + 1
    tablo(n, 1) = tablo(i, 1)
1 Next
With [F2] 'à adapter
    If n Then .Resize(n) = tablo
    .Offset(n).Resize(Rows.Count - n - .Row + 1).ClearContents 'RAZ en dessous
End With
End Sub

Option Compare Text 'la casse est ignorée

Sub lister()
Dim tablo, exclu, ub&, i&, x$, j&, n&
tablo = [A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
exclu = [D1].CurrentRegion.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
ub = UBound(exclu)
For i = 2 To UBound(tablo)
    x = Replace(tablo(i, 1), " ", "") 'supprime les espaces
    For j = 2 To ub
        If InStr(x, exclu(j, 1)) Then GoTo 1
    Next
    n = n + 1
    tablo(n, 1) = tablo(i, 1)
1 Next
With [F2] 'à adapter
    If n Then .Resize(n) = tablo
    .Offset(n).Resize(Rows.Count - n - .Row + 1).ClearContents 'RAZ en dessous
End With
End Sub