VBA boucle ou sélection multiple

Petit1986 -
Petit1986 - 4 déc. 2009 à 09:51

Bonjour,
Je cherche à utiliser la fonction "recheche" d'Excel et que toutes les valeurs trouvée soit copier dans une autre feuille. Mais j'ai des petits souci de boucle... Aidez moi SVP !!
Ci dessous le code :

Sub recherche()
'
' recherche Macro
'
On error Goto message_box
Cells.Find(What:="blablabla", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate 'fonction recherche
ActiveCell.Copy
Sheets("Feuil3").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Feuil1").Select 'copie et colle le résultat contenant blablabla

Do Until Cells.FindNext(After:=ActiveCell).Value <> Sheets("Feuil3").Range("A1").Value
'en théorie çà doit faire, jusqu'à ce que la valeur trouver soit égale à la première
ActiveCell.Copy
Sheets("Feuil3").Select
Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
ActiveSheet.Paste 'copie et colle dans la première cellule vide de la colonne ASheets("Feuil1").Select
Loop 'fait la boucle pour tout trouver

'mais çà, çà marche pas !!

message_box: Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "Il n'y a pas d'éléments comprenant la valeur souhaitée ou ERREUR" ' Définit le message.
Style = vbDefaultButton2 ' Définit les boutons.
Title = "Information " ' Définit le titre.
Help = "DEMO.HLP" ' Définit le fichier d'aide.
Ctxt = 1000 ' Définit le contexte de la rubrique.
' Affiche le message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)

End Sub

Merci de m'aider, parce que çà fait un petit moment que je cherche sans réussite !!
PS : je crois que vous l'aurez remarqué, je débute...
Merci
Bye
Petit1986

Afficher la suite

A voir également:

VBA boucle ou sélection multiple
Ecran multiple pc - Guide
Excel cellule choix multiple - Guide
Copier coller multiple - Guide
Mon pc s'allume et s'éteint en boucle - Forum Matériel & Système
Incompatibilité de type vba ✓ - Forum Programmation

3 réponses

Réponse 1 / 3

Bidouilleu_R Messages postés 1181 Date d'inscription Statut Membre Dernière intervention 295

tu mélanges la source et le but.
Essaie ça!
Attention les données en feuille 3 ne sont pas effacées et viennent s'ajouter dans la colonne A

Sub recherche()
'
' recherche Macro
'
On Error GoTo message_box
Sheets("feuil1").Select

'Cells.Find(What:="blablabla", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate 'fonction recherche
'ActiveCell.Copy

With Worksheets("feuil1").Range("a1:a500")
    Set c = .Find("blablabla", LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.Copy
            Sheets("feuil3").Select
            Range("A65535").End(xlUp).Offset(1, 0).Select
            ActiveSheet.Paste
            Sheets("feuil1").Select
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With


message_box: Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "Il n'y a pas d'éléments comprenant la valeur souhaitée ou ERREUR" ' Définit le message.
Style = vbDefaultButton2 ' Définit les boutons.
Title = "Information " ' Définit le titre.
Help = "DEMO.HLP" ' Définit le fichier d'aide.
Ctxt = 1000 ' Définit le contexte de la rubrique.
' Affiche le message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)

End Sub

Petit1986

Merci de ta réponse, mais çà ne marche pas !

il me met directement sur le message d'erreur...

Je creuse encore, mais si t'as d'autres idées, je suis preneur...

Mais merci de ta réponse

Réponse 2 / 3

Bidouilleu_R Messages postés 1181 Date d'inscription Statut Membre Dernière intervention 295

j'avais laissé le message pour te faire plaisir, mais de cette manière la macro
ne passera jamais dans le message car la boucle infinie est traitée avec le contrôle de la première adresse
et les vides sont exclus saauf si ce que tu recherche n'existe pas.

donc 1°) la macro fonctionne ( je vérifie ce que je post)
2°) tu aurais pu vérifié le résultat en feuille 3 à partir de laligne A2 avant de dire " ça marche pas"
3°) il est normal que le message se soit affiché, j'ai ajouté une ligne noté en gras
4°) Note que tu peux remplacer "blablabla par une variable.

Sub recherche()
'
' recherche Macro
'
On Error GoTo message_box
Sheets("feuil1").Select


With Worksheets("feuil1").Range("a1:a500")
    Set c = .Find("blablabla", LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.Copy
            Sheets("feuil3").Select
            Range("A65535").End(xlUp).Offset(1, 0).Select
            ActiveSheet.Paste
            Sheets("feuil1").Select
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With
GoTo fin

message_box: Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "Il n'y a pas d'éléments comprenant la valeur souhaitée ou ERREUR" ' Définit le message.
Style = vbDefaultButton2 ' Définit les boutons.
Title = "Information " ' Définit le titre.
Help = "DEMO.HLP" ' Définit le fichier d'aide.
Ctxt = 1000 ' Définit le contexte de la rubrique.
' Affiche le message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)

fin:

s = MsgBox("Tout s'est bien passé!", vbOKOnly, "Sortie du programme")End Sub

Réponse 3 / 3

Bidouilleu_R Messages postés 1181 Date d'inscription Statut Membre Dernière intervention 295

Oups!
j'ai oublié la ligne en gras

Goto Fin

et bien sur

Fin:
end sub

Petit1986

Merci,
J'ai failli remettre, "çà marche pas !!" mais ayant plus de doute sur mes capacité que sur les tiennes, j'ai creusé un peu et essayé de comprendre parce que je pense bien que tu vérifies tes post !
Mais oui, çà marche !
C'est juste que j'avais besoin d'adapter la macro à ma problèmatique car en effet je ne cherche pas "blablabla" mais bien une variable !!
Merci encore
A+
Bye

Discussions similaires

"L'indice n'appartient à la sélection" + VBA

Paris multiple : explications de 2/3, 3/4, 2/4, 2/5, etc.

Pari multiple 2/5 explications

erreur d'execution 9, l'indice n'appartient pas à la sélection

Tableau excel paris sportif multiple

Votre réponse

Discussions similaires