Créer une boucle pour éviter de répéter le même bloc en changeant juste une variable

**sobichi** · 22/11/2013, 12h59

Bonjour à tous,

Je suis débutante en VBA et je me forme toute seule en fonction de mon besoin, donc autant dire que je n'ai pas de bases solides

Je sollicite votre aide pour quelquechose de peut être trés simple mais aprés des jours à essayer je n'ai pas réussi à trouver une solution

Voici mon problème :
J'ai créé une Macro qui alimente un nouveau fichier excel (OT1 Factures à régler 2013 - Envoi du " & today) avec d'autres fichiers excel (SUIVI DES FACTURES xxxx) tous présents dans le même répertoire, des données sont copiées et collées dans le nouveau fichier excel selon condition.
En fait ce que je veut faire c'est :
- Aprés avoir créé mon nouveau fichier (OT1 Factures à régler 2013 - Envoi du " & today)
- Ouvrir chaque fichier excel contenu dans le répertoire
- Pour chaque fichier ouvert chercher la feuille appelé "Factures"
- Dans chaque feuille Factures trouvée : si en colonne O c'est écrit "à débloquer" alors copier toute la ligne et la coller dans le fichier (OT1 Factures à régler 2013 - Envoi du " & today) à la première ligne vide.
- Puis dans cette feuille Factures remplacer toutes les cellules contenant "à débloquer" par la date du jour pour indiquer que la ligne a été copiée dans le fichier de déblocage.

Alors voici ma Macro, elle marche mais il y a une boucle que je ne suis pas parvenue à faire : pour activer et traiter un par un les fichiers excels ouverts. Du coup j'ai donc répété un bloc plusieurs fois en changeant juste le nom de la feuille, ça marche mais j'ai un peu honte de laisser ça

J'ai mis la Macro en entier et coloré en rouge ce que j'aimerais améliorer.

Je vous remercie d'avance pour votre aide et vos conseils

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
Sub ESSAI()

Dim MonClasseur As Workbook
Set MonClasseur = Workbooks.Open("G:\x\x\x\x\x\2013\OT1\OT1 Factures à régler 2013 - DERNIERE VERSION.xls")

MonClasseur.Activate

Set MonClasseur = Workbooks.Add
today = Format(Date, "dd-mm-yyyy")
MonClasseur.SaveAs ("G:\x\x\x\x\x\2013\OT1\OT1 Factures à régler 2013 - Envoi du " & today)

Workbooks("OT1 Factures à régler 2013 - DERNIERE VERSION.xls").Activate
Sheets("OT1 Autorisation règlement_BLR").Select
Sheets("OT1 Autorisation règlement_BLR").Copy Before:=MonClasseur.Sheets(1)
Range("A1").Select
ActiveWorkbook.Save
Workbooks("OT1 Factures à régler 2013 - DERNIERE VERSION.xls").Activate
ActiveWorkbook.Save
ActiveWorkbook.Close

MonClasseur.Activate

today = Format(Date, "mm/dd/yyyy")

Worksheets("OT1 Autorisation règlement_BLR").Activate
With Worksheets("OT1 Autorisation règlement_BLR")
    If .FilterMode = True Then .ShowAllData
End With

Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveCell.Value = today
Range("A" & ActiveCell.Row & ":R" & ActiveCell.Row).Interior.ColorIndex = 13
Range("A" & ActiveCell.Row & ":R" & ActiveCell.Row).Font.Color = RGB(255, 255, 255)
Range("A" & ActiveCell.Row & ":R" & ActiveCell.Row).Font.Bold = True

Workbooks("TEST.xlsm").Activate

Dim MonRepertoire As String, fso As Object, f As Object, i As Integer
Set fso = CreateObject("Scripting.FileSystemObject")
MonRepertoire = "G:\x\x\x\x\SUIVI DES FACTURES - OT1\"
For Each f In fso.GetFolder(MonRepertoire).Files
    If Right(f.Name, 4) = ".xls" Then Workbooks.Open MonRepertoire & f.Name
Next f

Workbooks("SUIVI DES FACTURES M1").Activate
Worksheets("Factures").Activate
With ActiveSheet

Dim Cel As Range 'déclare la variable cel (CELlule)
Dim Dest As Range 'déclare la variable dest (DESTination)
For Each Cel In .Range("O2:O" & .Range("O65536").End(xlUp).Row) 'boucle sur toutes les cellules éditées de la colonne O
Select Case Cel.Value 'agit en fonction de la valeur de cel
        Case "à débloquer" 'cas "à débloquer"
            Set Dest = MonClasseur.Sheets("OT1 Autorisation règlement_BLR").Range("A65536").End(xlUp).Offset(1, 0) 'définit la variable dest
            Range(Cells(Cel.Row, 1), Cel).Copy Dest
  End Select
    Next Cel


today = Format(Date, "mm/dd/yyyy")
Dim Cellule As Range
    For Each Cellule In Range("O1:O65536")
        Select Case Cellule.Value
         Case "à débloquer"
           Cellule.Offset(0, 1) = today
             End Select
              Next Cellule



End With
Workbooks("SUIVI DES FACTURES M1").Save
Workbooks("SUIVI DES FACTURES M1").Close

Workbooks("SUIVI DES FACTURES MIV9").Activate
Worksheets("Factures").Activate
With ActiveSheet

For Each Cel In .Range("O2:O" & .Range("O65536").End(xlUp).Row) 'boucle sur toutes les cellules éditées de la colonne O
Select Case Cel.Value 'agit en fonction de la valeur de cel
        Case "à débloquer" 'cas "à débloquer"
            Set Dest = MonClasseur.Sheets("OT1 Autorisation règlement_BLR").Range("A65536").End(xlUp).Offset(1, 0) 'définit la variable dest
            Range(Cells(Cel.Row, 1), Cel).Copy Dest


  End Select
      Next Cel
    

today = Format(Date, "mm/dd/yyyy")

    For Each Cellule In Range("O1:O65536")
        Select Case Cellule.Value
         Case "à débloquer"
           Cellule.Offset(0, 1) = today
             End Select
              Next Cellule



End With
Workbooks("SUIVI DES FACTURES MIV9").Save
Workbooks("SUIVI DES FACTURES MIV9").Close

Workbooks("SUIVI DES FACTURES MWV7").Activate
Worksheets("Factures").Activate
With ActiveSheet


For Each Cel In .Range("O2:O" & .Range("O65536").End(xlUp).Row) 'boucle sur toutes les cellules éditées de la colonne O
Select Case Cel.Value 'agit en fonction de la valeur de cel
        Case "à débloquer" 'cas "à débloquer"
            Set Dest = MonClasseur.Sheets("OT1 Autorisation règlement_BLR").Range("A65536").End(xlUp).Offset(1, 0) 'définit la variable dest
            Range(Cells(Cel.Row, 1), Cel).Copy Dest


  End Select
      Next Cel
    


today = Format(Date, "mm/dd/yyyy")
    For Each Cellule In Range("O1:O65536")
        Select Case Cellule.Value
         Case "à débloquer"
           Cellule.Offset(0, 1) = today
             End Select
              Next Cellule



End With
Workbooks("SUIVI DES FACTURES MWV7").Save
Workbooks("SUIVI DES FACTURES MWV7").Close


Workbooks("SUIVI DES FACTURES MIaa").Activate
Worksheets("Factures").Activate
With ActiveSheet

For Each Cel In .Range("O2:O" & .Range("O65536").End(xlUp).Row) 'boucle sur toutes les cellules éditées de la colonne O
Select Case Cel.Value 'agit en fonction de la valeur de cel
        Case "à débloquer" 'cas "à débloquer"
            Set Dest = MonClasseur.Sheets("OT1 Autorisation règlement_BLR").Range("A65536").End(xlUp).Offset(1, 0) 'définit la variable dest
            Range(Cells(Cel.Row, 1), Cel).Copy Dest


  End Select
      Next Cel
    


today = Format(Date, "mm/dd/yyyy")
    For Each Cellule In Range("O1:O65536")
        Select Case Cellule.Value
         Case "à débloquer"
           Cellule.Offset(0, 1) = today
             End Select
              Next Cellule



End With
Workbooks("SUIVI DES FACTURES MIaa").Save
Workbooks("SUIVI DES FACTURES MIaa").Close

Workbooks("SUIVI DES FACTURES MJIO").Activate
Worksheets("Factures").Activate
With ActiveSheet

For Each Cel In .Range("O2:O" & .Range("O65536").End(xlUp).Row) 'boucle sur toutes les cellules éditées de la colonne O
Select Case Cel.Value 'agit en fonction de la valeur de cel
        Case "à débloquer" 'cas "à débloquer"
            Set Dest = MonClasseur.Sheets("OT1 Autorisation règlement_BLR").Range("A65536").End(xlUp).Offset(1, 0) 'définit la variable dest
            Range(Cells(Cel.Row, 1), Cel).Copy Dest


  End Select
      Next Cel
    


today = Format(Date, "mm/dd/yyyy")
    For Each Cellule In Range("O1:O65536")
        Select Case Cellule.Value
         Case "à débloquer"
           Cellule.Offset(0, 1) = today
             End Select
              Next Cellule



End With
Workbooks("SUIVI DES FACTURES MJIO").Save
Workbooks("SUIVI DES FACTURES MJIO").Close

Workbooks("SUIVI DES FACTURES KIHJ").Activate
Worksheets("Factures").Activate
With ActiveSheet

For Each Cel In .Range("O2:O" & .Range("O65536").End(xlUp).Row) 'boucle sur toutes les cellules éditées de la colonne O
Select Case Cel.Value 'agit en fonction de la valeur de cel
        Case "à débloquer" 'cas "à débloquer"
            Set Dest = MonClasseur.Sheets("OT1 Autorisation règlement_BLR").Range("A65536").End(xlUp).Offset(1, 0) 'définit la variable dest
            Range(Cells(Cel.Row, 1), Cel).Copy Dest


  End Select
      Next Cel
    


today = Format(Date, "mm/dd/yyyy")

    For Each Cellule In Range("O1:O65536")
        Select Case Cellule.Value
         Case "à débloquer"
           Cellule.Offset(0, 1) = today
             End Select
              Next Cellule



End With
Workbooks("SUIVI DES FACTURES KIHJ").Save
Workbooks("SUIVI DES FACTURES KIHJ").Close



Workbooks("SUIVI DES FACTURES TGBU").Activate
Worksheets("Factures").Activate
With ActiveSheet


For Each Cel In .Range("O2:O" & .Range("O65536").End(xlUp).Row) 'boucle sur toutes les cellules éditées de la colonne O
Select Case Cel.Value 'agit en fonction de la valeur de cel
        Case "à débloquer" 'cas "à débloquer"
            Set Dest = MonClasseur.Sheets("OT1 Autorisation règlement_BLR").Range("A65536").End(xlUp).Offset(1, 0) 'définit la variable dest
            Range(Cells(Cel.Row, 1), Cel).Copy Dest


  End Select
      Next Cel
    


today = Format(Date, "mm/dd/yyyy")

    For Each Cellule In Range("O1:O65536")
        Select Case Cellule.Value
         Case "à débloquer"
           Cellule.Offset(0, 1) = today
             End Select
              Next Cellule



End With
Workbooks("SUIVI DES FACTURES TGBU").Save
Workbooks("SUIVI DES FACTURES TGBU").Close


Workbooks("SUIVI DES FACTURES BHU").Activate
Worksheets("Factures").Activate
With ActiveSheet


For Each Cel In .Range("O2:O" & .Range("O65536").End(xlUp).Row) 'boucle sur toutes les cellules éditées de la colonne O
Select Case Cel.Value 'agit en fonction de la valeur de cel
        Case "à débloquer" 'cas "à débloquer"
            Set Dest = MonClasseur.Sheets("OT1 Autorisation règlement_BLR").Range("A65536").End(xlUp).Offset(1, 0) 'définit la variable dest
            Range(Cells(Cel.Row, 1), Cel).Copy Dest


  End Select
      Next Cel
    


today = Format(Date, "mm/dd/yyyy")

    For Each Cellule In Range("O1:O65536")
        Select Case Cellule.Value
         Case "à débloquer"
           Cellule.Offset(0, 1) = today
             End Select
              Next Cellule



End With
Workbooks("SUIVI DES FACTURES BHU").Save
Workbooks("SUIVI DES FACTURES BHU").Close


Workbooks("SUIVI DES FACTURES T").Activate
Worksheets("Factures").Activate
With ActiveSheet

For Each Cel In .Range("O2:O" & .Range("O65536").End(xlUp).Row) 'boucle sur toutes les cellules éditées de la colonne O
Select Case Cel.Value 'agit en fonction de la valeur de cel
        Case "à débloquer" 'cas "à débloquer"
            Set Dest = MonClasseur.Sheets("OT1 Autorisation règlement_BLR").Range("A65536").End(xlUp).Offset(1, 0) 'définit la variable dest
            Range(Cells(Cel.Row, 1), Cel).Copy Dest


  End Select
      
Next Cel
    


today = Format(Date, "mm/dd/yyyy")

    For Each Cellule In Range("O1:O65536")
        Select Case Cellule.Value
         Case "à débloquer"
           Cellule.Offset(0, 1) = today
             End Select
              Next Cellule



End With
Workbooks("SUIVI DES FACTURES T").Save
Workbooks("SUIVI DES FACTURES T").Close

Workbooks("SUIVI DES FACTURES HY").Activate
Worksheets("Factures").Activate
With ActiveSheet


For Each Cel In .Range("O2:O" & .Range("O65536").End(xlUp).Row) 'boucle sur toutes les cellules éditées de la colonne O
Select Case Cel.Value 'agit en fonction de la valeur de cel
        Case "à débloquer" 'cas "à débloquer"
            Set Dest = MonClasseur.Sheets("OT1 Autorisation règlement_BLR").Range("A65536").End(xlUp).Offset(1, 0) 'définit la variable dest
            Range(Cells(Cel.Row, 1), Cel).Copy Dest


  End Select
      Next Cel
    


today = Format(Date, "mm/dd/yyyy")

    For Each Cellule In Range("O1:O65536")
        Select Case Cellule.Value
         Case "à débloquer"
           Cellule.Offset(0, 1) = today
             End Select
              Next Cellule



End With
Workbooks("SUIVI DES FACTURES HY").Save
Workbooks("SUIVI DES FACTURES HY").Close
End Sub

**casefayere** · 22/11/2013, 14h40

Bonjour,

To post est un roman

et comme je suis peut-être bête, en lisant, ne serait-ce que le début de ton code, je ne vois pas dans quel classeur cette macro "Sub ESSAI()" est insérée, quand tu auras répondu, j'essayerai de t'aider, je répète, j'essayerai, mais il y a une trés grande chance que je ne m'occupe que de ton énoncé et non du code qui m'a l'air......

Bon courage

**sobichi** · 22/11/2013, 15h22

Bonjour casefayere,

Merci beaucoup de t'interesser à mon problème

C'est mon premier post donc je reconnais que je ne suis peut être pas trés claire.

En fait cette Macro "Sub ESSAI()" est insérée dans un fichier excel vide que j'ai appelé TEST dans lequel je ne mettrai que des boutons affectés à des macros.

Pour expliquer mieux ma macro je peux décrire le code "ligne par ligne" si besoin.

**casefayere** · 22/11/2013, 15h30

Pour expliquer mieux ma macro je peux décrire le code "ligne par ligne" si besoin.

Non, non, sans vouloir te vexer, je préfère repartir sur une base saine, tu as déjà montré ta volonté d'y arriver.

Surtout Patience ! quoique d'autres intervenants peuvent (et tant mieux) apporter leurs idées entre-temps

**sobichi** · 22/11/2013, 16h22

ha ha ha, je ne suis pas vexée, je comprends

Je te remercie beaucoup pour ton aide!!

**casefayere** · 22/11/2013, 16h39

Bon, je pense qu'il y a du boulot et il va falloir que je parte, je m'y remettrai plus tard, espérons que quelqu'un passe par là.......

Avant que je partes, ne serait-il pas mieux de récréer une nouvelle sub après "Workbooks("TEST.xlsm").Activate", comme je n'ai pas décrypté toute la procédure, les traitements (en rouge) sont'ils les mêmes pour tous les fichiers ?, ont-ils la même structure ?

**nibledispo** · 22/11/2013, 22h39

bonsoir,

j'ai cru comprendre que c'est la partie ci dessous qui se répète au nom du fichier près.(j'ai remplacer les select par if) puisqu'un seul choix.

je ne suis pas très au point avec la manipulation des fichiers et tout paticulièrement les folder.

Ne serait-ce tout simple pas cela que tu veux ?

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
28
29
 
 
Dim MonRepertoire As String, fso As Object, f As Object, i As Integer
Set fso = CreateObject("Scripting.FileSystemObject")
MonRepertoire = "G:\x\x\x\x\SUIVI DES FACTURES - OT1\"
 
For Each f In fso.GetFolder(MonRepertoire).Files
    If Right(f.Name, 4) = ".xls" Then Workbooks.Open MonRepertoire & f.Name
' partie répétitive
    Workbooks(f.Name).Activate
    Worksheets("Factures").Activate
    With ActiveSheet
        For Each Cel In .Range("O2:O" & .Range("O65536").End(xlUp).Row) 'boucle sur toutes les cellules éditées de la colonne O
            If Cel.Value = "à débloquer" Then
               Set Dest = MonClasseur.Sheets("OT1 Autorisation règlement_BLR").Range("A65536").End(xlUp).Offset(1, 0) 'définit la variable dest
               Range(Cells(Cel.Row, 1), Cel).Copy Dest
            End If
        Next Cel
 
        today = Format(Date, "mm/dd/yyyy")
        For Each Cellule In Range("O1:O65536") 'n'est-ce pas plutot O2
            If Cellule.Value = "à débloquer" Then
               Cellule.Offset(0, 1) = today
            End If
        Next Cellule
    End With
    Workbooks(f.Name).Save
    Workbooks(f.Name).Close
Next f

les connaisseurs sauront dire si je suis dans l'erreur.

cordialement

**casefayere** · 23/11/2013, 12h58

Bonjour le forum, sobichi, parmi, nibledispo,

Avant toute chose
Sobichi, quand tu écris :

Alors c'est bon on peut récréer une nouvelle sub

et si tu as des variables communes, il faut les déclarer, soit en haut de module avant toute procédure, soit en "Public", en tete d'un module quelconque, exemple

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Option Explicit
 
Dim x
Sub toto()
x = 2
titi
MsgBox x
End Sub
Sub titi()
x = x + 2
End Sub

maintenant, j'aime quand d'autres membres amènent leur avis, en suivant les conseils de parmi, en testant la proposition de nibledispo (j'avoue que je n'ai pas regardé mais le principe de la boucle est indispensable, à mon avis), tu peux donc, pour la clarté adapté la proposition de nibledispo dans un nouveau module

Bon courage

Bonne journée à tou(te)s

**sobichi** · 25/11/2013, 11h10

Bonjour à tous,

Merci beaucoup parmi, nibledispo et casefayere pour vos conseils

Je vais tester vos propositions et essayer d'appliquer vos conseils.

Je reviens vers vous trés vite pour vous dire si j'ai réussi à m'en sortir

Créer une boucle pour éviter de répéter le même bloc en changeant juste une variable

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager