Syntaxe pour un traitement en boucle

Version imprimable

Bonjour,

Je dois développer une macro qui effectuera les manipulations suivantes:

1) Repérer un mot-clé ("toto") dans une cellule du classeur A

2) Couper/coller cette cellule dans un nouveau classeur B

3) Revenir au classeur A

4) Repérer la cellule suivante qui contient "toto"

5) Couper/coller la cellule dans le classeur B, en dessous de la cellule qui a été coupée/collée en 2)

6) Ainsi de suite jusqu'à ce qu'il n'y ai plus de cellule qui contienne le mot-clé dans le classeur A.

Que devrais-je utiliser, un Do While, un Do Loop ?

Quel serait la structure de la macro afin d'éviter une "boucle infinie" ?

le code de l'action à répéter en boucle jusqu'à ce qu'il n'y ait plus de cellule avec "toto" dedans est le suivant:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 Workbooks.Add ChDir "C:\Documents and Settings\ARummens\Desktop\VBA" ActiveWorkbook.SaveAs Filename:= _ "C:\Documents and Settings\ARummens\Desktop\VBA\Résumé.xls", _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False Windows("Fichier Test.xls").Activate Cells.Find(What:="toto", After:=ActiveCell, LookIn:=xlValues, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate Range(ActiveCell, ActiveCell.Offset(15, 0)).Select Selection.Cut Windows("Résumé.xls").Activate ActiveSheet.Paste
merci d'avance !

Bonjour,

Perso je n'utiliserais ni Do While, ni Do Loop mais Find et FindNext.
Il y a un détail qui me perturbe entre ta description des opérations à effectuer et ton code.
Dans ta description tu dis "Couper/coller la cellule" et dans ton code tu prends la cellule + les 15 en dessous "Range(ActiveCell, ActiveCell.Offset(15, 0))" :question:

Donc je te propose ci-dessous les deux possibilités :

Copie de la cellule "toto" uniquement

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub test_toto1()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim Chemin As String, NomFich As String
 
Chemin = "C:\Documents and Settings\ARummens\Desktop\VBA\"
NomFich = "Résumé.xls"
 
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=Chemin & NomFich
 
Set WS1 = Workbooks("Fichier Test.xls").Sheets(1)
Set WS2 = Workbooks("Résumé.xls").Sheets(1)
 
Set C1 = WS1.Cells.Find("toto", , , xlWhole)
If Not C1 Is Nothing Then
    C1.Cut WS2.Cells(65535, 1).End(xlUp)(2)
suite:
    Set C2 = WS1.Cells.FindNext(ActiveCell)
    If Not C2 Is Nothing Then
        C2.Cut WS2.Cells(65535, 1).End(xlUp)(2)
        GoTo suite
    End If
End If
 
Workbooks("resume_toto.xls").Save
 
End Sub

Copie de la cellule "toto" + les 15 cellules en dessous

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub test_toto2()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim Chemin As String, NomFich As String
 
Chemin = "C:\Documents and Settings\ARummens\Desktop\VBA\"
NomFich = "Résumé.xls"
 
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=Chemin & NomFich
 
Set WS1 = Workbooks("Fichier Test.xls").Sheets(1)
Set WS2 = Workbooks("Résumé.xls").Sheets(1)
 
Set C1 = WS1.Cells.Find("toto", , , xlWhole)
If Not C1 Is Nothing Then
    Range(C1, C1.Offset(15, 0)).Cut WS2.Cells(65535, 1).End(xlUp)(2)
suite:
    Set C2 = WS1.Cells.FindNext(ActiveCell)
    If Not C2 Is Nothing Then
        Range(C2, C2.Offset(15, 0)).Cut WS2.Cells(65535, 1).End(xlUp)(2)
        GoTo suite
    End If
End If
 
Workbooks("resume_toto.xls").Save
 
End Sub

23/04/2008, 15h30
Shaia79

Bonjour,

tout d'abord merci pour ta réponse.

Oui effectivement il s'agit de copier la cellule avec 'toto' ainsi que les 15 autres cellules en dessous

Si je "traduis" ton code, est ce que je peux dire que, dans l'ordre du code:

1 tu déclares les variables
2 avec la commande Set, tu définis ces variables
3 Tu définies les critères de recherche avec C1

Puis tu commences le if, avec d'abord la condition sur C1

Code:

If Not C1 Is Nothing Then

, qui signifie "s'il y a toto dans une cellule au moins une fois, alors faire ce qui suit"

puis la condition sur C2, qui est le "next" de C1 et permet d'effectuer la recherche jusqu'à ce que tous les "toto" soient trouvés dans WS1

pour la ligne

Code:

GoTo suite

, est ce que suite est un mot reconnu par défaut par excel ? est ce que c'est le mot qui définit l'exécution en boucle ?

Pour en revenir à la macro elle-même, j'ai un pb quand je l'éxecute; erreur d'exécution 9: l'indice n'appartient pas à la sélection sur la ligne

Code:

Set WS2 = Workbooks("résumé.xls").Sheets(1)
23/04/2008, 16h31
fring

Citation:

Envoyé par Shaia79

Oui effectivement il s'agit de copier la cellule avec 'toto' ainsi que les 15 autres cellules en dessous

il faut donc utiliser le second code

Citation:

Envoyé par Shaia79

Si je "traduis" ton code, est ce que je peux dire que, dans l'ordre du code:

1 tu déclares les variables
2 avec la commande Set, tu définis ces variables
3 Tu définies les critères de recherche avec C1

Puis tu commences le if, avec d'abord la condition sur C1

Code:

If Not C1 Is Nothing Then

, qui signifie "s'il y a toto dans une cellule au moins une fois, alors faire ce qui suit"

puis la condition sur C2, qui est le "next" de C1 et permet d'effectuer la recherche jusqu'à ce que tous les "toto" soient trouvés dans WS1

Oui c'est bien ça, C2 est le résultat de la recherche effectuée par FindNext mais pour que FindNext fonctionne, il faut d'abord effectuer un Find

Citation:

Envoyé par Shaia79

pour la ligne

Code:

GoTo suite

, est ce que suite est un mot reconnu par défaut par excel ? est ce que c'est le mot qui définit l'exécution en boucle ?

non c'est toi qui définis le mot "suite" et c'est bien ce qui va faire la boucle, tant qu'il trouvera un "toto" on retourne à la ligne "suite:" et on recommence la recherche

Citation:

Envoyé par Shaia79

Pour en revenir à la macro elle-même, j'ai un pb quand je l'éxecute; erreur d'exécution 9: l'indice n'appartient pas à la sélection sur la ligne

Code:

Set WS2 = Workbooks("résumé.xls").Sheets(1)

J'avais fait le test avant de te proposer le code et aucun problème de mon côté.
Le nouveau classeur "Résumé.xls" est bien créé ?