Macros Excel

Option Explicit 
Sub Test() 
Dim wshResultat As Worksheet     'Feuille résultat 
Dim rngDestination As Range      'Ligne de destination des données 
Dim strCherche As String         'Mot cherché 
Dim wsh As Worksheet             'Feuille analysée 
Dim cel As Range                 'Cellule trouvée contenant le mot cherché 
Dim adr As String                'Adresse de la première cellule trouvée 

'Affectation de la feuille de destination 
Set wshResultat = ThisWorkbook.Worksheets("Feuil1") 
'Affectation de la ligne de destination 
Set rngDestination = wshResultat.Rows(1) 
'Affectation du mot cherché 
strCherche = "Patrice" 

'Analyser chaque feuille du classeur... 
For Each wsh In ThisWorkbook.Worksheets 
  '... sauf la feuille résultat 
  If wsh.Index <> wshResultat.Index Then 
    'Chercher le mot 
    Set cel = wsh.UsedRange.Find(strCherche) 
    'Si le mot est trouvé ... 
    If Not cel Is Nothing Then 
      '... relever l'emplacement (l'adresse) de la première cellule trouvée. 
      adr = cel.Address 
      'Répeter les opérations suivantes ... 
      Do 
        ' - Copier la ligne trouvée vers la ligne de destination 
        rngDestination.Value = cel.EntireRow.Value 
        ' - Affecter la prochaine destination à la ligne suivante 
        Set rngDestination = rngDestination.Offset(1) 
        ' - Chercher le mot suivant sur la feuille 
        Set cel = wsh.UsedRange.Find(strCherche, cel) 
      '... tant qu'on n'est pas revenu sur le premier emplacement trouvé. 
      Loop While adr <> cel.Address 
    End If 
  End If 
Next wsh 

End Sub