Sub Rechercher()
Dim cible$, a, tablo, resu(), i&, e, s, j%, n&
cible = SansAccent(LCase(CStr([B2])))
a = Array(1, 3, 7, 9)
tablo = [Tableau1].Resize(, 9) 'matrice, plus rapide, au moins 2 éléments
ReDim resu(1 To UBound(tablo), 1 To 4)
For i = 1 To UBound(tablo)
For Each e In a
s = Split(tablo(i, e)) 'séparateur espace
For j = 0 To UBound(s)
If SansAccent(LCase(s(j))) = cible Then
n = n + 1
resu(n, 1) = tablo(i, 1)
resu(n, 2) = tablo(i, 3)
resu(n, 3) = tablo(i, 7)
resu(n, 4) = tablo(i, 9)
GoTo 1
End If
Next j, e
1 Next i
'---restitution---
With [A6] '1ère cellule de destination
If n Then .Resize(n, 4) = resu
.Offset(n).Resize(Rows.Count - n - .Row + 1, 4).ClearContents 'RAZ en dessous
End With
End Sub