Rechercher par mot clé

=SI(ESTNUM(CHERCHE('moteur de recherche'!$L$6;'Base de Données'!$D$4:$D$1000));LIGNE('Base de Données'!$D$4:$D$1000))

=SIERREUR(INDEX('Base de Données'!F:F;PETITE.VALEUR(matrice;LIGNE()-8));"")

Private Sub Worksheet_Activate()
Worksheet_Change [A1] 'lance la macro
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a, ub%, crit$, tablo, resu(), i&, n&, j%
a = Array(1, 6, 7, 11, 12, 16, 15)
ub = UBound(a)
crit = "*" & LCase([D6]) & "*"
With Sheets("Base de Données")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    tablo = .Range("A1", .Range("D" & .Rows.Count).End(xlUp)).Resize(, Application.Max(a)) 'matrice, plus rapide
End With
'---remplissage de resu---
ReDim resu(UBound(tablo) - 1, ub) 'base 0
For i = 4 To UBound(tablo)
    If crit <> "**" And LCase(tablo(i, 4)) Like crit Then
        For j = 0 To ub
            resu(n, j) = tablo(i, a(j))
        Next j
        n = n + 1
    End If
Next i
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
Application.EnableEvents = False 'désactive les évènements
With [A9]
    If n Then
        .Resize(n, ub + 1) = resu
        .Resize(n, ub + 1).Borders.Weight = xlThin 'bordures
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, ub + 1).Delete xlUp 'RAZ en dessous
End With
Application.EnableEvents = True 'réactive les évènements
End Sub