Discussion :

[Shaia79]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 !

[fring]

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))"

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

1. Copie de la cellule "toto" uniquement
   

   Code :

   Sélectionner tout - Visualiser dans une fenêtre à part

   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

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

   Code :

   Sélectionner tout - Visualiser dans une fenêtre à part

   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

[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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[fring]

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

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

pour la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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éé ?