Copier/coller dans nouveau classeur la ou les feuille(s) sélectionnée avec checkbox

**apache84** · 29/01/2014, 13h18

Bonjour à tous, je suis tous nouveau dans la programmation je suis sous excel 2007 et je rencontre quelques petits soucis (en faite pour moi c'est un gros )
Donc voilà j'ai une trentaine de checkbox correspondant chaqun a une feuille et je voudrais que lorsque je coche le checkbox, ça me copie la ou les feuilles cochés dans un nouveau classeur où je donnerais le chemin moi même. mais je galère si je met la totalité ca me donne une erreur "procédure trop grande " quand je les prend une par une ça fonctionne. j'ai essayé avec la fonction Call la première fonctionne et les deux suivante came copie le classeur entier. A l'aide SVP

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
360
361
362
363
364
365
366
367
368
369
Sub CommandButton700()
Application.ScreenUpdating = False
Dim objSaveBox As FileDialog
Dim sh As Shape
'
'
If EVCD = False And ANOT = False And ARPI = False And ATRA = False And AVEN = False And CBA = False And C = False And MAIL = False And MEQI = False And OCAR = False And VAIG = False And VECA = False And VEVO = False And PERS = False And DSEC = False And REMA = False And ANSI = False And CBA2 = False And DERA = False And MV = False And RATO = False And S = False And VEFE = False And AGSM = False And CHEX = False And FREP = False And JAMA = False And MATA = False And SECO = False And ICAB = False Then 'pas checkbox cochées
MsgBox "Vous devez selectionner au moins une feuille", vbInformation + vbOKOnly
Exit Sub
 
ElseIf EVCD = True And ANOT = False And ARPI = False And ATRA = False And AVEN = False And CBA = False And C = False And MAIL = False And MEQI = False And OCAR = False And VAIG = False And VECA = False And VEVO = False And PERS = False And DSEC = False And REMA = False And ANSI = False And CBA2 = False And DERA = False And MV = False And RATO = False And S = False And VEFE = False And AGSM = False And CHEX = False And FREP = False And JAMA = False And MATA = False And SECO = False And ICAB = False Then 'pas checkbox cochées
 
Sheets(Array("evenement conduite")).Select ' selectionne la feuille
Sheets(Array("evenement conduite")).Copy 'la copie
ActiveSheet.Unprotect Password:="SoLeNe84"
Sheets("evenement conduite").Select
Cells.Copy
Cells.PasteSpecial xlPasteValues ' on fait un copier-coller valeur pour supprimer les formules, et donc les liaisons
Range("A1").Select
For Each sh In ActiveSheet.Shapes
If Not sh.Name Like "cible" And Not sh.Name Like "logo" Then sh.Delete
Next sh
Range("A1:AO150").Select
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect Password:="SoLeNe84", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Protect Structure:=True, Windows:=False, Password:="SoLeNe84"
 
Sheets("evenement conduite").Select
Range("A1").Select
 
ElseIf EVCD = False And ANOT = True And ARPI = False And ATRA = False And AVEN = False And CBA = False And C = False And MAIL = False And MEQI = False And OCAR = False And VAIG = False And VECA = False And VEVO = False And PERS = False And DSEC = False And REMA = False And ANSI = False And CBA2 = False And DERA = False And MV = False And RATO = False And S = False And VEFE = False And AGSM = False And CHEX = False And FREP = False And JAMA = False And MATA = False And SECO = False And ICAB = False Then 'pas checkbox cochées
 
Sheets(Array("ANOT")).Select ' selectionne la feuille
Sheets(Array("ANOT")).Copy 'la copie
ActiveSheet.Unprotect Password:="SoLeNe84"
Sheets("ANOT").Select
Cells.Copy
Cells.PasteSpecial xlPasteValues ' on fait un copier-coller valeur pour supprimer les formules, et donc les liaisons
Range("A1").Select
For Each sh In ActiveSheet.Shapes
If Not sh.Name Like "cible" And Not sh.Name Like "logo" Then sh.Delete
Next sh
Range("A1:AO150").Select
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect Password:="SoLeNe84", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Protect Structure:=True, Windows:=False, Password:="SoLeNe84"
 
Sheets("ANOT").Select
Range("A1").Select
 
 
 
ElseIf EVCD = False And ANOT = False And ARPI = True And ATRA = False And AVEN = False And CBA = False And C = False And MAIL = False And MEQI = False And OCAR = False And VAIG = False And VECA = False And VEVO = False And PERS = False And DSEC = False And REMA = False And ANSI = False And CBA2 = False And DERA = False And MV = False And RATO = False And S = False And VEFE = False And AGSM = False And CHEX = False And FREP = False And JAMA = False And MATA = False And SECO = False And ICAB = False Then 'pas checkbox cochées
 
Sheets(Array("ARPI")).Select
Sheets(Array("ARPI")).Copy
ActiveSheet.Unprotect Password:="SoLeNe84"
Sheets("ARPI").Select
Cells.Copy
Cells.PasteSpecial xlPasteValues ' on fait un copier-coller valeur pour supprimer les formules, et donc les liaisons
Range("A1").Select
For Each sh In ActiveSheet.Shapes
If Not sh.Name Like "cible" And Not sh.Name Like "logo" Then sh.Delete
Next sh
Range("A1:AO150").Select
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect Password:="SoLeNe84", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Protect Structure:=True, Windows:=False, Password:="SoLeNe84"
 
Sheets("ARPI").Select
Range("A1").Select
 
 
 
Là, j'ai enlevé la suite car trop long ca va jusqu'à icab
 
 
 
End If
Set objSaveBox = Application.FileDialog(msoFileDialogSaveAs)
 
With objSaveBox
 
 
'Définit le type de fichier par défaut:
'(la valeur 4 Permet de spécifier les classeurs "Excel 97-2003" lorsque vous êtes dans Excel 2007)
.FilterIndex = 4
 
'Affiche la boîte de dialogue
.Show
'Enregistre
.Execute
End With
ActiveWindow.Close 'ferme le nouveau classeur
Unload UserForm20
Sheets("accueil").Select
Application.ScreenUpdating = True
 
CommandButton701
End Sub
 
Sub CommandButton701()
Application.ScreenUpdating = False
Dim objSaveBox As FileDialog
Dim sh As Shape
 
 
ElseIf EVCD = True And ANOT = True And ARPI = False And ATRA = False And AVEN = False And CBA = False And C = False And MAIL = False And MEQI = False And OCAR = False And VAIG = False And VECA = False And VEVO = False And PERS = False And DSEC = False And REMA = False And ANSI = False And CBA2 = False And DERA = False And MV = False And RATO = False And S = False And VEFE = False And AGSM = False And CHEX = False And FREP = False And JAMA = False And MATA = False And SECO = False And ICAB = False Then 'pas checkbox cochées
Sheets(Array("evenement conduite", "ANOT")).Select
Sheets(Array("evenement conduite", "ANOT")).Copy
Sheets("evenement conduite").Unprotect Password:="SoLeNe84"
Sheets("ANOT").Unprotect Password:="SoLeNe84"
Sheets(Array("evenement conduite", "ANOT")).Select
Cells.Copy
Cells.PasteSpecial xlPasteValues ' on fait un copier-coller valeur pour supprimer les formules, et donc les liaisons
Range("A1").Select
 
Sheets("evenement conduite").Select
For Each sh In ActiveSheet.Shapes
If Not sh.Name Like "cible" And Not sh.Name Like "logo" Then sh.Delete
Next sh
Range("A1:AO150").Select
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect Password:="SoLeNe84", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Protect Structure:=True, Windows:=False, Password:="SoLeNe84"
Range("A1").Select
ActiveWindow.SmallScroll Down:=-135
 
Sheets("ANOT").Select
For Each sh In ActiveSheet.Shapes
If Not sh.Name Like "cible" And Not sh.Name Like "logo" Then sh.Delete
Next sh
Range("A1:AO150").Select
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect Password:="SoLeNe84", DrawingObjects:=True, Contents:=True, Scenarios:=True
Range("A1").Select
ActiveWindow.SmallScroll Down:=-135
 
Sheets("evenement conduite").Select
 
ElseIf EVCD = True And ANOT = False And ARPI = True And ATRA = False And AVEN = False And CBA = False And C = False And MAIL = False And MEQI = False And OCAR = False And VAIG = False And VECA = False And VEVO = False And PERS = False And DSEC = False And REMA = False And ANSI = False And CBA2 = False And DERA = False And MV = False And RATO = False And S = False And VEFE = False And AGSM = False And CHEX = False And FREP = False And JAMA = False And MATA = False And SECO = False And ICAB = False Then 'pas checkbox cochées
Sheets(Array("evenement conduite", "ARPI")).Select
Sheets(Array("evenement conduite", "ARPI")).Copy
Sheets("evenement conduite").Unprotect Password:="SoLeNe84"
Sheets("ARPI").Unprotect Password:="SoLeNe84"
Sheets(Array("evenement conduite", "ARPI")).Select
Cells.Copy
Cells.PasteSpecial xlPasteValues ' on fait un copier-coller valeur pour supprimer les formules, et donc les liaisons
Range("A1").Select
 
Sheets("evenement conduite").Select
For Each sh In ActiveSheet.Shapes
If Not sh.Name Like "cible" And Not sh.Name Like "logo" Then sh.Delete
Next sh
Range("A1:AO150").Select
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect Password:="SoLeNe84", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Protect Structure:=True, Windows:=False, Password:="SoLeNe84"
Range("A1").Select
ActiveWindow.SmallScroll Down:=-135
 
Sheets("ARPI").Select
For Each sh In ActiveSheet.Shapes
If Not sh.Name Like "cible" And Not sh.Name Like "logo" Then sh.Delete
Next sh
Range("A1:AO150").Select
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect Password:="SoLeNe84", DrawingObjects:=True, Contents:=True, Scenarios:=True
Range("A1").Select
ActiveWindow.SmallScroll Down:=-135
 
Sheets("evenement conduite").Select
 
ElseIf EVCD = True And ANOT = False And ARPI = False And ATRA = True And AVEN = False And CBA = False And C = False And MAIL = False And MEQI = False And OCAR = False And VAIG = False And VECA = False And VEVO = False And PERS = False And DSEC = False And REMA = False And ANSI = False And CBA2 = False And DERA = False And MV = False And RATO = False And S = False And VEFE = False And AGSM = False And CHEX = False And FREP = False And JAMA = False And MATA = False And SECO = False And ICAB = False Then 'pas checkbox cochées
Sheets(Array("evenement conduite", "ATRA")).Select
Sheets(Array("evenement conduite", "ATRA")).Copy
Sheets("evenement conduite").Unprotect Password:="SoLeNe84"
Sheets("ATRA").Unprotect Password:="SoLeNe84"
Sheets(Array("evenement conduite", "ATRA")).Select
Cells.Copy
Cells.PasteSpecial xlPasteValues ' on fait un copier-coller valeur pour supprimer les formules, et donc les liaisons
Range("A1").Select
 
Sheets("evenement conduite").Select
For Each sh In ActiveSheet.Shapes
If Not sh.Name Like "cible" And Not sh.Name Like "logo" Then sh.Delete
Next sh
Range("A1:AO150").Select
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect Password:="SoLeNe84", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Protect Structure:=True, Windows:=False, Password:="SoLeNe84"
Range("A1").Select
ActiveWindow.SmallScroll Down:=-135
 
Sheets("ATRA").Select
For Each sh In ActiveSheet.Shapes
If Not sh.Name Like "cible" And Not sh.Name Like "logo" Then sh.Delete
Next sh
Range("A1:AO150").Select
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect Password:="SoLeNe84", DrawingObjects:=True, Contents:=True, Scenarios:=True
Range("A1").Select
ActiveWindow.SmallScroll Down:=-135
 
Sheets("evenement conduite").Select
 
ElseIf EVCD = True And ANOT = False And ARPI = False And ATRA = False And AVEN = True And CBA = False And C = False And MAIL = False And MEQI = False And OCAR = False And VAIG = False And VECA = False And VEVO = False And PERS = False And DSEC = False And REMA = False And ANSI = False And CBA2 = False And DERA = False And MV = False And RATO = False And S = False And VEFE = False And AGSM = False And CHEX = False And FREP = False And JAMA = False And MATA = False And SECO = False And ICAB = False Then 'pas checkbox cochées
Sheets(Array("evenement conduite", "AVEN")).Select
Sheets(Array("evenement conduite", "AVEN")).Copy
Sheets("evenement conduite").Unprotect Password:="SoLeNe84"
Sheets("AVEN").Unprotect Password:="SoLeNe84"
Sheets(Array("evenement conduite", "AVEN")).Select
Cells.Copy
Cells.PasteSpecial xlPasteValues ' on fait un copier-coller valeur pour supprimer les formules, et donc les liaisons
Range("A1").Select
 
Sheets("evenement conduite").Select
For Each sh In ActiveSheet.Shapes
If Not sh.Name Like "cible" And Not sh.Name Like "logo" Then sh.Delete
Next sh
Range("A1:AO150").Select
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect Password:="SoLeNe84", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Protect Structure:=True, Windows:=False, Password:="SoLeNe84"
Range("A1").Select
ActiveWindow.SmallScroll Down:=-135
 
Sheets("AVEN").Select
For Each sh In ActiveSheet.Shapes
If Not sh.Name Like "cible" And Not sh.Name Like "logo" Then sh.Delete
Next sh
Range("A1:AO150").Select
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect Password:="SoLeNe84", DrawingObjects:=True, Contents:=True, Scenarios:=True
Range("A1").Select
ActiveWindow.SmallScroll Down:=-135
 
Sheets("evenement conduite").Select
 
 
Là, j'ai enlevé la suite car trop long ca va jusqu'à "evenement conduite", "AVEN"
 
 
End If
Set objSaveBox = Application.FileDialog(msoFileDialogSaveAs)
 
With objSaveBox
 
 
'Définit le type de fichier par défaut:
'(la valeur 4 Permet de spécifier les classeurs "Excel 97-2003" lorsque vous êtes dans Excel 2007)
.FilterIndex = 4
 
'Affiche la boîte de dialogue
.Show
'Enregistre
.Execute
End With
ActiveWindow.Close 'ferme le nouveau classeur
Unload UserForm20
Sheets("accueil").Select
Application.ScreenUpdating = True
CommandButton702
End Sub
 
Sub CommandButton702()
Application.ScreenUpdating = False
Dim objSaveBox As FileDialog
Dim sh As Shape
 
 
 
 
ElseIf EVCD = True And ANOT = True And ARPI = True And ATRA = True And AVEN = True And CBA = True And C = True And MAIL = True And MEQI = True And OCAR = True And VAIG = True And VECA = True And VEVO = True And PERS = True And DSEC = True And REMA = True And ANSI = True And CBA2 = True And DERA = True And MV = True And RATO = True And S = True And VEFE = True And AGSM = True And CHEX = True And FREP = True And JAMA = True And MATA = True And SECO = True And ICAB = True Then 'pas checkbox cochées
Sheets(Array("evenement conduite", "ANOT", "ARPI", "ATRA", "AVEN", "CBA", "C", "MAIL", "MEQI", "OCAR", "VAIG", "VECA", "VEVO", "PERS", "DSEC", "REMA", "ANSI", "CBA2", "DERA", "MV", "RATO", "S", "VEFE", "AGSM", "CHEX", "FREP", "JAMA", "MATA", "SECO", "ICAB")).Select
Sheets(Array("evenement conduite", "ANOT", "ARPI", "ATRA", "AVEN", "CBA", "C", "MAIL", "MEQI", "OCAR", "VAIG", "VECA", "VEVO", "PERS", "DSEC", "REMA", "ANSI", "CBA2", "DERA", "MV", "RATO", "S", "VEFE", "AGSM", "CHEX", "FREP", "JAMA", "MATA", "SECO", "ICAB")).Copy
Sheets("evenement conduite").Unprotect Password:="SoLeNe84"
Sheets("ANOT").Unprotect Password:="SoLeNe84"
Sheets("ARPI").Unprotect Password:="SoLeNe84"
Sheets("ATRA").Unprotect Password:="SoLeNe84"
Sheets("AVEN").Unprotect Password:="SoLeNe84"
Sheets("CBA").Unprotect Password:="SoLeNe84"
Sheets("C").Unprotect Password:="SoLeNe84"
Sheets("MAIL").Unprotect Password:="SoLeNe84"
Sheets("MEQI").Unprotect Password:="SoLeNe84"
Sheets("OCAR").Unprotect Password:="SoLeNe84"
Sheets("VAIG").Unprotect Password:="SoLeNe84"
Sheets("VECA").Unprotect Password:="SoLeNe84"
Sheets("VEVO").Unprotect Password:="SoLeNe84"
Sheets("PERS").Unprotect Password:="SoLeNe84"
Sheets("DSEC").Unprotect Password:="SoLeNe84"
Sheets("REMA").Unprotect Password:="SoLeNe84"
Sheets("ANSI").Unprotect Password:="SoLeNe84"
Sheets("CBA2").Unprotect Password:="SoLeNe84"
Sheets("DERA").Unprotect Password:="SoLeNe84"
Sheets("CBA").Unprotect Password:="SoLeNe84"
Sheets("MV").Unprotect Password:="SoLeNe84"
Sheets("RATO").Unprotect Password:="SoLeNe84"
Sheets("S").Unprotect Password:="SoLeNe84"
Sheets("VEFE").Unprotect Password:="SoLeNe84"
Sheets("AGSM").Unprotect Password:="SoLeNe84"
Sheets("CHEX").Unprotect Password:="SoLeNe84"
Sheets("FREP").Unprotect Password:="SoLeNe84"
Sheets("JAMA").Unprotect Password:="SoLeNe84"
Sheets("MATA").Unprotect Password:="SoLeNe84"
Sheets("SECO").Unprotect Password:="SoLeNe84"
Sheets("ICAB").Unprotect Password:="SoLeNe84"
Sheets(Array("evenement conduite", "ANOT", "ARPI", "ATRA", "AVEN", "CBA", "C", "MAIL", "MEQI", "OCAR", "VAIG", "VECA", "VEVO", "PERS", "DSEC", "REMA", "ANSI", "CBA2", "DERA", "MV", "RATO", "S", "VEFE", "AGSM", "CHEX", "FREP", "JAMA", "MATA", "SECO", "ICAB")).Select
Cells.Copy
Cells.PasteSpecial xlPasteValues ' on fait un copier-coller valeur pour supprimer les formules, et donc les liaisons
Range("A1").Select
 
Sheets("evenement conduite").Select
For Each sh In ActiveSheet.Shapes
If Not sh.Name Like "cible" And Not sh.Name Like "logo" Then sh.Delete
Next sh
Range("C20:AO50").Select
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect Password:="SoLeNe84", DrawingObjects:=True, Contents:=True, Scenarios:=True
Range("A1").Select
ActiveWindow.SmallScroll Down:=-135
 
 
Sheets("ANOT").Select
For Each sh In ActiveSheet.Shapes
If Not sh.Name Like "cible" And Not sh.Name Like "logo" Then sh.Delete
Next sh
Range("C20:AO50").Select
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect Password:="SoLeNe84", DrawingObjects:=True, Contents:=True, Scenarios:=True
Range("A1").Select
ActiveWindow.SmallScroll Down:=-135
 
 
 
End If
Set objSaveBox = Application.FileDialog(msoFileDialogSaveAs)
 
With objSaveBox
 
 
'Définit le type de fichier par défaut:
'(la valeur 4 Permet de spécifier les classeurs "Excel 97-2003" lorsque vous êtes dans Excel 2007)
.FilterIndex = 4
 
'Affiche la boîte de dialogue
.Show
'Enregistre
.Execute
End With
ActiveWindow.Close 'ferme le nouveau classeur
Unload UserForm20
Sheets("accueil").Select
Application.ScreenUpdating = True
 
End Sub

Là, j'ai enlevé la suite car trop long ca va jusqu'à "icab"

Merci d'avance. dsl je l'ai posté ailleurs mais je me suis trompé.

**defluc** · 29/01/2014, 15h59

Bonjour,

Je crois que tu vas décourager tout le monde de te répondre en balançant une source si longue et très difficile à lire du fait du manque d'indentation.

je suis tous nouveau dans la programmation

Alors, il faut commencer par le début : les principes de base, des petits bouts de code sur des actions limitées. Et au fur et à mesure que tu avanceras pas à pas, tu assembleras les morceaux pour arriver au résultat voulu.

Qui trop embrasse mal étreint.

Bonne recherche, bonne étude et bon travail.

**parmi** · 29/01/2014, 16h04

Bonjour,

Houston, on a un problème...

Une façon de faire serait d'utiliser la propriété Tag des checkbox et d'y mettre les noms des feuilles correspondantes à chaque checkbox.

Ensuite, essaie ce petit bout de code

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
Private Sub CommandButton1_Click()
    Dim Ctl As Control
    Dim Idx As Long
    Dim arrFeuilles() As String
 
    'On passe chaque contrôle du UserForm
    For Each Ctl In Me.Controls
        'Si c'est un checkbox
        If TypeOf Ctl Is msforms.CheckBox Then
            'et qu'il est coché
            If Ctl.Value = True Then
                'on met dans un tableau (Array) qui va servir pour sélectionner les feuilles
                ReDim Preserve arrFeuilles(Idx)
                arrFeuilles(Idx) = Ctl.Tag
                Idx = Idx + 1
            End If
        End If
    Next
 
    ThisWorkbook.Sheets(arrFeuilles).Select
 
End Sub

Ce code va sélectionner toutes les feuilles qui ont été cochées.
Il restera à copier cette sélection dans un autre classeur vierge, le cas échéant, et ensuite tu fais une boucle sur toutes les feuilles de ce classeur et tu supprimes les contrôles nécessaires, et tu enlèves les liaisons externes (voir BreakLink)

Si chaque feuille doit être copiée dans des classeurs individuels, il n'y a donc pas lieu d'utiliser de Array de la façon dont tu procèdes, mais juste passer par une boucle qui lit les tags et copie chaque feuille au fur et à mesure.

**apache84** · 30/01/2014, 14h08

bonsoir, ce que je voudrais c'est que les feuilles sectionnées soie mise dans un seul classeur au format .xls pour qu'il soie lu par tous. je ne veux pas faire de classeur individuel

merci. bonne soirée

Bonjour, super pour le code, il fonctionne bien mais je n'arrive pas a supprimer les bouton sur le nouveau classeur. ça me les supprime sur la première feuille mais pas sur les autres et je n'arrive pas a lui faire prendre en compte le chemin . comment faire voici le code. Merci d'avance

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
Private Sub CommandButton65_Click()
    Application.ScreenUpdating = False
    Dim Ctl As Control
    Dim Idx As Long
    Dim arrFeuilles() As String
    Dim objSaveBox As FileDialog
    Dim chemin As Variant
    Dim sh As Shape
    'On passe chaque contrôle du UserForm
    For Each Ctl In Me.Controls
        'Si c'est un checkbox
        If TypeOf Ctl Is msforms.CheckBox Then
            'et qu'il est coché
            If Ctl.Value = True Then
                'on met dans un tableau (Array) qui va servir pour sélectionner les feuilles
                ReDim Preserve arrFeuilles(Idx)
                arrFeuilles(Idx) = Ctl.Tag
                Idx = Idx + 1
            End If
        End If
    Next
 
    ThisWorkbook.Sheets(arrFeuilles).Select
    ThisWorkbook.Sheets(arrFeuilles).Copy
    ActiveSheet.Unprotect Password:="SoLeNe84"
 
    Cells.Copy
    Cells.PasteSpecial xlPasteValues ' on fait un copier-coller valeur pour supprimer les formules, et donc les liaisons
    Range("A1").Select
    For Each sh In ActiveSheet.Shapes
    If Not sh.Name Like "cible" And Not sh.Name Like "logo" Then sh.Delete
    Next sh
    Range("A1:AO110").Select
    Selection.Locked = True
    Selection.FormulaHidden = False
    ActiveSheet.Protect Password:="SoLeNe84", DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveWorkbook.Protect Structure:=True, Windows:=False, Password:="SoLeNe84"
 
 
    Range("D1").Select
    ActiveWindow.SmallScroll Down:=-135
 
 
   Set objSaveBox = Application.FileDialog(msoFileDialogSaveAs)
 
    With objSaveBox
 
 chemin = (Range("a2").Value & "_" & Range("A3").Text)
    'enregistre sous
        'Définit le type de fichier par défaut:
        '(la valeur 4 Permet de spécifier les classeurs "Excel 97-2003" lorsque vous êtes dans Excel 2007)
        .FilterIndex = 4
 
        'Affiche la boîte de dialogue
        .Show
        'Enregistre
        .Execute
    End With
    ActiveWindow.Close  'ferme le nouveau classeur
    Unload UserForm20
    Sheets("accueil").Select
    Application.ScreenUpdating = True
 
End Sub

**parmi** · 30/01/2014, 14h38

Après avoir copié tes feuilles dans le nouveau classeur, il te faut une boucle pour passer à travers chaque feuille

Quelque chose comme

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
Dim Feuille as Worksheet
 
For each Feuille in Activeworkbook
   Feuille.activate
   Activesheet.Unprotect "SoLeNe84"
   Cells.Copy
   Cells.PasteSpecial xlPasteValues ' on fait un copier-coller valeur pour supprimer les formules, et donc les liaisons
   Range("A1").Select
   For Each sh In ActiveSheet.Shapes
      If Not sh.Name Like "cible" And Not sh.Name Like "logo" Then sh.Delete
   Next sh
   Range("A1:AO110").Locked = True
   Range("A1:AO110").FormulaHidden = False
   ActiveSheet.Protect Password:="SoLeNe84", DrawingObjects:=True, Contents:=True, Scenarios:=True
 
Next

Une fois que tu as fait le tour des feuilles, tu peux protéger la structure du fichier et le sauvegarder sous le nom que tu veux.

Et n'oublie pas d'utiliser le # pour formater ton code quand tu en mets un...

**apache84** · 31/01/2014, 17h37

Bonjour, ce code fonctionne super bien sauf que je réussi à supprimer les boutons sur la première feuille et pas sur les autres du nouveau classeur.
si vous pouvez me le modifier et me le renvoyer?
Un grand Merci d'avance

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
Private Sub CommandButton65_Click()
    Application.ScreenUpdating = False
    Dim Ctl As Control
    Dim Idx As Long
    Dim arrFeuilles() As String
    Dim objSaveBox As FileDialog
    Dim chemin As Variant
    Dim sh As Shape
    'On passe chaque contrôle du UserForm
    For Each Ctl In Me.Controls
        'Si c'est un checkbox
        If TypeOf Ctl Is msforms.CheckBox Then
            'et qu'il est coché
            If Ctl.Value = True Then
                'on met dans un tableau (Array) qui va servir pour sélectionner les feuilles
                ReDim Preserve arrFeuilles(Idx)
                arrFeuilles(Idx) = Ctl.Tag
                Idx = Idx + 1
            End If
        End If
    Next
 
    ThisWorkbook.Sheets(arrFeuilles).Select
    ThisWorkbook.Sheets(arrFeuilles).Copy
    ActiveSheet.Unprotect Password:="SoLeNe84"
 
    Cells.Copy
    Cells.PasteSpecial xlPasteValues ' on fait un copier-coller valeur pour supprimer les formules, et donc les liaisons
    Range("A1").Select
    For Each sh In ActiveSheet.Shapes
    If Not sh.Name Like "cible" And Not sh.Name Like "logo" Then sh.Delete
    Next sh
    Range("A1:AO110").Select
    Selection.Locked = True
    Selection.FormulaHidden = False
    ActiveSheet.Protect Password:="SoLeNe84", DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveWorkbook.Protect Structure:=True, Windows:=False, Password:="SoLeNe84"
 
 
    Range("D1").Select
    ActiveWindow.SmallScroll Down:=-135
 
 
   Set objSaveBox = Application.FileDialog(msoFileDialogSaveAs)
 
    With objSaveBox
 
 chemin = (Range("a2").Value & "_" & Range("A3").Text)
    'enregistre sous
        'Définit le type de fichier par défaut:
        '(la valeur 4 Permet de spécifier les classeurs "Excel 97-2003" lorsque vous êtes dans Excel 2007)
        .FilterIndex = 4
 
        'Affiche la boîte de dialogue
        .Show
        'Enregistre
        .Execute
    End With
    ActiveWindow.Close  'ferme le nouveau classeur
    Unload UserForm20
    Sheets("accueil").Select
    Application.ScreenUpdating = True
 
End Sub

**parmi** · 31/01/2014, 18h00

As-tu bien lu mon précédent message ?
Il te faut boucler chaque feuille.
Une fois dans une feuille, là tu enlèves ta protection, tu copies en valeur et tu effaces tes Shapes

**apache84** · 31/01/2014, 22h16

désoler je ne sais pas faire. je vais essayer de trouver si je peine, je reviendrais vous embêter. Merci

Bonsoir, je galère a fon mais je persiste!!!!!

**apache84** · 01/02/2014, 11h08

Bonjour, désolé mais je n'arrive pas a fais ma boucle pour les feuilles de mon nouveau classeur pour supprimer tous les boutons de toute les feuilles. j'ai bien lu les message précédant mais je n'arrive pas a faire cette boucle. elle march très bien sur la première feuille mais pas sur les autres.

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
Private Sub CommandButton65_Click()
    Application.ScreenUpdating = False
    Dim Ctl As Control
    Dim Idx As Long
    Dim arrFeuilles() As String
    Dim objSaveBox As FileDialog
    Dim chemin As Variant
    Dim sh As Shape
    'On passe chaque contrôle du UserForm
    For Each Ctl In Me.Controls
        'Si c'est un checkbox
        If TypeOf Ctl Is msforms.CheckBox Then
            'et qu'il est coché
            If Ctl.Value = True Then
                'on met dans un tableau (Array) qui va servir pour sélectionner les feuilles
                ReDim Preserve arrFeuilles(Idx)
                arrFeuilles(Idx) = Ctl.Tag
                Idx = Idx + 1
            End If
        End If
    Next
 
    ThisWorkbook.Sheets(arrFeuilles).Select
    ThisWorkbook.Sheets(arrFeuilles).Copy
    ActiveSheet.Unprotect Password:="SoLeNe84"
 
    Cells.Copy
    Cells.PasteSpecial xlPasteValues ' on fait un copier-coller valeur pour supprimer les formules, et donc les liaisons
    Range("A1").Select
    For Each sh In ActiveSheet.Shapes
    If Not sh.Name Like "cible" And Not sh.Name Like "logo" Then sh.Delete
    Next sh
    Range("A1:AO110").Select
    Selection.Locked = True
    Selection.FormulaHidden = False
    ActiveSheet.Protect Password:="SoLeNe84", DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveWorkbook.Protect Structure:=True, Windows:=False, Password:="SoLeNe84"
 
 
    Range("D1").Select
    ActiveWindow.SmallScroll Down:=-135
 
 
   Set objSaveBox = Application.FileDialog(msoFileDialogSaveAs)
 
    With objSaveBox
 
 chemin = (Range("a2").Value & "_" & Range("A3").Text)
    'enregistre sous
        'Définit le type de fichier par défaut:
        '(la valeur 4 Permet de spécifier les classeurs "Excel 97-2003" lorsque vous êtes dans Excel 2007)
        .FilterIndex = 4
 
        'Affiche la boîte de dialogue
        .Show
        'Enregistre
        .Execute
    End With
    ActiveWindow.Close  'ferme le nouveau classeur
    Unload UserForm20
    Sheets("accueil").Select
    Application.ScreenUpdating = True
 
End Sub

Merci d'avance. Bonne journée a tous

**apache84** · 01/02/2014, 17h19

Bonjour Parmi désolé j'essai de rentrer ce que tu m'as envoyé pour faire la boucle mais quand je la lance ça me met un code erreur :

erreur d'execution 438 propriete ou methode non geree par cet objet

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
Private Sub CommandButton65_Click()
    Application.ScreenUpdating = False
    Dim Ctl As Control
    Dim Idx As Long
    Dim arrFeuilles() As String
    Dim Feuille As Worksheet
    Dim objSaveBox As FileDialog
    Dim chemin As Variant
    Dim sh As Shape
    'On passe chaque contrôle du UserForm
    For Each Ctl In Me.Controls
        'Si c'est un checkbox
        If TypeOf Ctl Is msforms.CheckBox Then
            'et qu'il est coché
            If Ctl.Value = True Then
                'on met dans un tableau (Array) qui va servir pour sélectionner les feuilles
                ReDim Preserve arrFeuilles(Idx)
                arrFeuilles(Idx) = Ctl.Tag
                Idx = Idx + 1
            End If
        End If
    Next
 
    ThisWorkbook.Sheets(arrFeuilles).Select
    ThisWorkbook.Sheets(arrFeuilles).Copy
   For Each Feuille In ActiveWorkbook
   Feuille.Activate
   ActiveSheet.Unprotect "SoLeNe84"
   Cells.Copy
   Cells.PasteSpecial xlPasteValues ' on fait un copier-coller valeur pour supprimer les formules, et donc les liaisons
   Range("A1").Select
   For Each sh In ActiveSheet.Shapes
      If Not sh.Name Like "cible" And Not sh.Name Like "logo" Then sh.Delete
   Next sh
   Range("A1:AO110").Locked = True
   Range("A1:AO110").FormulaHidden = False
   ActiveSheet.Protect Password:="SoLeNe84", DrawingObjects:=True, Contents:=True, Scenarios:=True
 
Next
 
    Range("D1").Select
    ActiveWindow.SmallScroll Down:=-135
 
 
   Set objSaveBox = Application.FileDialog(msoFileDialogSaveAs)
 
    With objSaveBox
 
 chemin = (Range("a2").Value & "_" & Range("A3").Text)
    'enregistre sous
        'Définit le type de fichier par défaut:
        '(la valeur 4 Permet de spécifier les classeurs "Excel 97-2003" lorsque vous êtes dans Excel 2007)
        .FilterIndex = 4
 
        'Affiche la boîte de dialogue
        .Show
        'Enregistre
        .Execute
    End With
    ActiveWindow.Close  'ferme le nouveau classeur
    Unload UserForm20
    Sheets("accueil").Select
    Application.ScreenUpdating = True
 
End Sub

ça va surement t’énerver désolé. Merci

Copier/coller dans nouveau classeur la ou les feuille(s) sélectionnée avec checkbox [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager