Macro de recherche : afficher la ligne entière

Bonjour

Je sais pas si ce problème a déjà été posé, mais je n'ai rien trouvé d'existant qui a pu m'apporter satisfaction...

Voilà, je dispose d'une macro de recherche qui, une fois le terme/référence/code trouvé m'affiche un lien hyper texte dans la colonne A de ma Feuil1 me renvoyant sur la cellule en question qui se situe dans les autres feuilles.

Pour l'améliorer j'aimerais afficher tout la ligne (ou les lignes si la recherche trouve plusieurs cellules qui matchent) correspondante, et dans l'ordre. C'est a dire, par exemple, que si ma cellule recherchée se trouve dans la colonne C de ma Feuil3, il faudrait qu'elle se retrouve Feuil1 non pas colonne A mais colonne C (les colonnes A, B, D... seraient complétées par les infos de la ligne en question).

Voici le code :

Sub recherche(mot)
On Error GoTo fin
ligne = 10
For Each ws In Sheets
If ws.Name <> "Recherche" Then
With ws.Cells
    Set c = .Find(mot, LookIn:=xlValues, lookat:=xlPart)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
         Sheets("Recherche").Cells(ligne, 1).Select
         Selection.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
          ws.Name & "!" & c.Address, TextToDisplay:=c.Value
          ligne = ligne + 1
          Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
      trouve = True
    End If
End With
End If
Next ws
If Not trouve Then MsgBox (" [" & mot & "] ne figure pas dans ce fichier")
fin:
End Sub

Merci d'avance

Bonjour,

Sub recherche(mot)
    On Error GoTo fin
    ligne = 10
    For Each ws In Sheets
    If ws.Name <> "Recherche" Then
    With ws.Cells
        Set C = .Find(mot, LookIn:=xlValues, lookat:=xlPart)
        If Not C Is Nothing Then
            firstAddress = C.Address
            Do
                Sheets("Recherche").Cells(ligne, C.Column).Select
                Selection.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
                ws.Name & "!" & C.Address, TextToDisplay:=C.Value
                ws.Range(ws.Cells(C.Row, 1), ws.Cells(C.Row, C.Column - 1)).Copy Sheets("Recherche").Cells(ligne, 1)
              ligne = ligne + 1
              Set C = .FindNext(C)
            Loop While Not C Is Nothing And C.Address <> firstAddress
          trouve = True
        End If
    End With
    End If
    Next ws
    If Not trouve Then MsgBox (" [" & mot & "] ne figure pas dans ce fichier")
fin:
End Sub

Super merci ! c'est vraiment ça l'idée !

Cependant deux petits problèmes subsistent :

- ta modification n'affiche que la partie gauche de la ligne où se trouve la cellule (ex : si ma recherche se trouve en C, le resultat donne les infos contenue dans la ligne uniquement de A à C).

- lSeulle la colonne A se réinitialise à chaque nouvelle recherche. Si d'autres infos ne viennent pas se mettre par dessus (auquel cas ça ne pose pas de soucis), les infos de la précédente recherche restent, ce qui peux causer de graves erreurs.

Je vais essayer de regarder tout ça mais je suis tellement novice...

Je vous joins un exemple pour que vous compreniez mieux

J'ai modifié le code afin que la ligne complète soit copiée, ce qui doit résoudre les 2 problèmes que tu évoquais.

Sub recherche(mot)
On Error GoTo fin
ligne = 10
For Each ws In Sheets
If ws.Name <> "Recherche" Then
With ws.Cells
    Set C = .Find(mot, LookIn:=xlValues, lookat:=xlPart)
    If Not C Is Nothing Then
        firstAddress = C.Address
        Do
            C.EntireRow.Copy Sheets("Recherche").Cells(ligne, 1)
            Sheets("Recherche").Cells(ligne, C.Column).Select
            Selection.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
            ws.Name & "!" & C.Address, TextToDisplay:=C.Value
            ligne = ligne + 1
            Set C = .FindNext(C)
        Loop While Not C Is Nothing And C.Address <> firstAddress
      trouve = True
    End If
End With
End If
Next ws
If Not trouve Then MsgBox (" [" & mot & "] ne figure pas dans ce fichier")
fin:
End Sub

Par contre, si tu souhaites effectuer un effacement complet avant d'effectuer une nouvelle copie, il faut que tu précises quelle est la plage qui doit être effacée. S'il s'agit de la ligne 10 à la dernière ligne de la feuille tu peux ajouter la ligne de code

    Range(Rows(10), Rows(10).End(xlDown)).ClearContents

A+

Tout marche super !

Et pour atteindre la perfection... quand on clic sur annuler, ça affiche en ligne 10 la première ligne du tableau de recherche. Je suis désolé de chipoter à ce point j'ai essayé de chercher d'où ça pouvait venir mais impossible de résoudre le problème pour l'instant.

Promis ça sera ma dernière question tu m'as déjà considérablement bien aidé !

J'ai trouvé ! je clos le sujet, merci mille fois frangy !

Pour ceux qui seraient à la recherche de la solution il suffit d'ajouter

If reponse = "" Then Exit Sub

à la commande du bouton (un annuler renvoie un blanc)

A plus