Recherche par mot clé

Option Explicit

Sub Recherche()

Dim F1 As Worksheet ' feuille où il y a le mot clé
Dim F2 As Worksheet ' autres feuilles
Dim cle ' mot-clé
Dim k%

Const ColonneRecherche = 4    'si on recherche le mot cle dans la colonne 4 (D) des feuilles
Const ColonneResultat1 = 5
Const ColonneResultat2 = 6

Const ColonneMettreResultat1 = 2
Const ColonneMettreResultat2 = 3

Dim LigneResultat%

Dim Rng As Range
  LigneResultat = 1                         ' ligne où on mettra le 1er résultat
  Set F1 = Worksheets("Feuil1")             ' mettre le nom de la feuille contenant le mot-clé
  cle = CStr(F1.Cells(3, 1))                ' coordonnées de la case contenant le mot-clé
  
  For Each F2 In Worksheets                     ' recherche dans toutes les feuilles
    If F2.Name <> F1.Name Then                  ' sauf la feuille du mot-clé

      For k = F2.UsedRange.Row To F2.UsedRange.Row + F2.UsedRange.Rows.Count - 1 ' balayage des lignes
        If CStr(F2.Cells(k, ColonneRecherche)) = cle Then   ' youppie ! on en a un !
          ' recopier infos vers la 1ère page
          F1.Cells(LigneResultat, ColonneMettreResultat1) = F2.Cells(k, ColonneResultat1)
          F1.Cells(LigneResultat, ColonneMettreResultat2) = F2.Cells(k, ColonneResultat2)
          LigneResultat = LigneResultat + 1           ' se préparer pour la ligne suivante dans la 1ère page
        End If
      Next k
    End If
  Next F2
End Sub