Macro de recherche dans une base de données

Bonsoir
ceci devrait faire l'affaire.
remplace ton code par celui ci

Sub recherche()
 Dim cell As Range
 Application.ScreenUpdating = False
 
  marecherche = InputBox("Saisir la ou les premières lettres du mot ", "Recherche de mot (s) ")
  If marecherche = "" Then Exit Sub
  DL = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
  For Each cell In ActiveSheet.Range("B4:B" & DL)
  If cell.Value = marecherche Then
 cell.Value = "*" & marecherche & "*"
 End If
 Next
  Set resultat = ActiveSheet.Range("B4:B" & DL).Find(what:="*" & marecherche & "*", Lookat:=xlWhole)
      Range("b4").Select
      Selection.AutoFilter
      Selection.AutoFilter Field:=2, Criteria1:="*" & marecherche & "*", Operator:=xlAnd
 Application.ScreenUpdating = True
  End Sub

bien cordialement

Je vous remercie beaucoup pour votre réponse, c'est excellent .

par contre j'avais une 2ème question .
jusqu'ici j'enlevais le filtrage automatique avec cette macro qui marche bien,mais pour des listes très longues cela prend du temps .

Sub Macro2()
Selection.AutoFilter Field:=1
Selection.AutoFilter Field:=2
Selection.AutoFilter Field:=3
Selection.AutoFilter Field:=4
Selection.AutoFilter Field:=5
End Sub

dans le forum , j'ai trouvé cette macro ci-dessous qui est beaucoup plus rapide ,par contre elle supprime le carrément le filtrage automatique.

Sub rétablir()
On Error GoTo finerreur
Selection.AutoFilter
GoTo fin
finerreur:
fin:
End Sub

Y aurait-il un moyen d'y remédier ?

Merci d'avance

fichier modifié
A tester

https://cjoint.com/c/HBcvzfgcmti
cordialement

Bonjour,

remet-le dans la foulée :

Sub retablir()
    [A1].AutoFilter
    [A1].AutoFilter
End Sub

eric