Imputbox Recherche + Copie résultat

[Mr.Nobody]

Hello,

Pourriez-vous m'aider à corriger mon code qui doit avoir pour fonction :

- Un Bouton qui renvoie vers une macro ImputBox avec une fenêtre pour l'utilisateur ( Réussi ).
- En fonction de la saisie du l'utilisateur, la macro va aller rechercher dans trois autres feuilles ( 2013;2012;etc ) le mot rechercher ( Nom, prénom, etc... ) & copier la ou les lignes correspondantes ainsi que si possible l'en tête du tableau dans les autres feuilles ( en ligne 4). La mise en page doit être conservé si possible.

Ainsi l'utilisateur obtient un résultat sous forme de tableau prêt à être copier/coller sur la première feuille ( Appelé Find dans mon code).

    Dim Resultat As Range
    Dim RechercheMot As String
 
 
    RechercheMot = InputBox("Nom ? Prénom ? Date ?")
 
    Set Resultat = Worksheets("2013").Range("A1:F5000").Cells.Find(RechercheMot, , xlValues, xlWhole)
    
 
    If Resultat Is Nothing Then
 
        MsgBox "Aucunes correspondances trouvées..."
 
    Else
    
 For Each vCellule In Selection
 
If vCellule.Value = RechercherMot Then
Rows(vCellule.Row).Copy Sheets("Find").[a1].End(xlUp)


End If
Next
 
End If
End Sub

Voici mon code, je pense que ça coince au niveau de la ligne pour copier les données... je me perd un peu !

Auriez-vous une idée?

Merci d'avance,
Cordialement

 

[Pierrot93]

Re : Imputbox Recherche + Copie résultat

Bonjour,

regarde peut être ceci, si cela peut te faire avancer :

With Sheets("Find")
    Rows(vCellule.Row).Copy .Rows(.[a1].End(xlUp).Row + 1)
End With

bon après midi
@+

 

[Mr.Nobody]

Re : Imputbox Recherche + Copie résultat

Bonjour Pierrot,
merci pour ta réponse rapide.

Je viens d'essayer mais j'ai peur de ne pas avoir saisi où in intégrer ce bout de code...
De plus je viens de m'en rendre compte que j'avais oublié de déclaré la variable VCellule !


Voici ou j'en suis :

    Dim Resultat As Range
    Dim RechercheMot As String
    Dim Vcellule As Object
 
 
    RechercheMot = InputBox("Nom ? Prénom ? Date ?")
 
    Set Resultat = Worksheets("2013").Range("A1:F5000").Cells.Find(RechercheMot, , xlValues, xlWhole)
    
 
    If Resultat Is Nothing Then
 
        MsgBox "Aucunes correspondances trouvées..."
 
    Else
   
 For Each Vcellule In Selection
  If Vcellule.Value = RechercheMot Then
  
With Sheets("Find")
    Rows(Vcellule.Row).Copy .Rows(.[a1].End(xlUp).Row + 1)
End With

End If
Next
 
End If
End Sub

Malheureusement ça ne fonctionne toujours pas :-/

Merci

 

[Pierrot93]

Re : Imputbox Recherche + Copie résultat

Re,

Malheureusement ça ne fonctionne toujours pas :-/

cela veut dire quoi? message d'erreur ou pas le résultat attendu... un tout petit fichier en pièce jointe serait plus facile pour t'aider....

 

[Mr.Nobody]

Re : Imputbox Recherche + Copie résultat

Pas de messages d'erreurs mais les résultats ne s'affichent pas.

Voici mon fichier en simplifié :

Merci beaucoup.

 

[Pierrot93]

Re : Imputbox Recherche + Copie résultat

Re,

regarde ceci :

Option Explicit
Sub test()
Dim Resultat As Range
Dim RechercheMot As String
Dim Vcellule As Object
RechercheMot = InputBox("Nom ? Prénom ? Date ?")
Set Resultat = Worksheets("2013").Range("A1:F5000").Cells.Find(RechercheMot, , xlValues, xlWhole)
If Resultat Is Nothing Then
    MsgBox "Aucunes correspondances trouvées..."
Else
    With Sheets("Find")
        Sheets("2013").Rows(Resultat.Row).Copy .Range("A65536").End(xlUp)(2)
    End With
End If
End Sub

 

[Mr.Nobody]

Re : Imputbox Recherche + Copie résultat

Merci Pierrot !

ça fonctionne très bien !

Juste un dernier détail, quand il y a plusieurs lignes pour un même mot clef ( Exemple 4 prénoms sur différentes lignes ) la macro ne copie que la première ligne et non tous les résultats trouvés ( comme la fonction rechercher tout ).

Est-ce possible que cette macro prenne en compte tous les résultats?

Merci d'avance.

Bonne journée

 

[Pierrot93]

Re : Imputbox Recherche + Copie résultat

Re,

Est-ce possible que cette macro prenne en compte tous les résultats?

pour ce faire, il faut utiliser "findNext" dans une boucle, regarde dans l'aide vba, il y a un exemple...

 

[Mr.Nobody]

Re : Imputbox Recherche + Copie résultat

Effectivement cette fonction semble convenir; voilà ce que ça donne :

Sub test()
Dim Resultat As Range
 Dim FirstFound As String
Dim RechercheMot As String
Dim Vcellule As Object
RechercheMot = InputBox("Nom ? Prénom ? Date ?")
Set Resultat = Worksheets("2013").Range("A1:F5000").Cells.Find(RechercheMot, , xlValues, xlWhole)
If Not Resultat Is Nothing Then
   With Sheets("Find")
        Sheets("2013").Rows(Resultat.Row).Copy .Range("A65536").End(xlUp)(2)
        FirstFound = Resultat.Address
        Do
        Set Resultat = .FindNext(Resultat)
       If Not Resultat Is Nothing Then
    Sheets("2013").Rows(Resultat.Row).Copy .Range("A65536").End(xlUp)(2)
Else
 MsgBox "Aucune correspondance trouvée..."
    End If
    
                Loop While Resultat.Address <> FirstFound
    End With
    End If
    
End Sub

La macro se lance mais se coupe à partir du .FindNext en me renvoyant « Propriété ou méthode non gérée par cet objet ».

Je ne vois pas l'erreur du coup... Une idée s'il te plait?

Cordialement

 

[Pierrot93]

Re : Imputbox Recherche + Copie résultat

Bonjour,

essaye comme ceci :

Option Explicit
Sub test()
Dim Resultat As Range
Dim FirstFound As String
Dim RechercheMot As String
RechercheMot = InputBox("Nom ? Prénom ? Date ?")
With Worksheets("2013").Range("A1:F5000").Cells
    Set Resultat = .Find(RechercheMot, , xlValues, xlWhole)
    If Not Resultat Is Nothing Then
        FirstFound = Resultat.Address
        Do
            Sheets("2013").Rows(Resultat.Row).Copy Sheets("Find").Range("A65536").End(xlUp)(2)
            Set Resultat = .FindNext(Resultat)
        Loop While Resultat.Address <> FirstFound
    Else
        MsgBox "Aucune correspondance trouvée..."
    End If
End With
End Sub

bonne journée
@+

 

[Mr.Nobody]

Re : Imputbox Recherche + Copie résultat

Bonjour Pierrot,

Je me doutais que j'avais raté quelques choses après le Do...
ça parait pourtant simple quand on le regarde ! C'est parfait, j'ai adapté un petit peu pour rechercher sur plusieurs et ça marche niquel.

Je te remercie beaucoup pour ton aide !

Bonne journée à toi & à bientot.