Macros Excel

Question

Bonjour @ tous, 


Je souhaiterais créer une macro qui me permettrait, dans excel, de rechercher un mot dans l'ensemble des feuilles du classeur, puis de copier chaque ligne contenant ce mot, et de les coller dans une autre feuille.

Je suis absolument perdu dans la création de macro.

Si quelqu'un peut me sortir la formule, ça serait top!

merci bien

Patrice33740 · Answer

Bonjour,

Voici une macro qui répond à ton problème, il faudra l'adapter à ton besoin :

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

Cordialement
Patrice

Macros Excel

1 réponse

Newsletters