VBA COPY methode erreur, SVP!

Version imprimable

Bonjour,

J'ai un soucis avec la méthode "copy". En effet, j'essaie de copier les données d'une feuille se trouvant dans mon book "yearly report" dans un autre classeur en fonction de la date.

Merci pour votre aide!

Citation:

Copy method of Worksheet class failed" error 1004... (which is a "unfound book " error I think)

Voici mon code:

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
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
debut: 'OPEN THE BOOK: ON ERROR (CANNOT FIND THE BOOK) --> CREATE IT
 
'1) Open the right file
Path = y_year & " " & Client & " - Planning " & ".xlsx"
'MsgBox "Path save: " & Path 'check the name
'Link the path
Set xlBook6 = xlApp6.Workbooks.Open("C:\OPS Contract Tool\Yearly Report\" & Path)
 
On Error GoTo errorws6:
 
ws6debut:
 
MsgBox "WS6 DEBUT"
 
'Read the right sheet
 
name_Sheet = "DR " & Month(Now()) & " " & Year(Now())
Set ws6 = xlBook6.Sheets(name_Sheet)
 
MsgBox "ws6 name " & ws6.Name 'THIS LEADS ME TO THE "errorws6" BECAUSE THE name of the sheet is not existing, so I need to create it by copying in the template book.
 
xlApp6.Visible = True
...
...
...
...
...
...
 
errorws6:
 
If Err.number = 9 Then
 
[INDENT][INDENT]MsgBox "Error number 9"
 
Set xlBook5 = xlApp5.Workbooks.Open("C:\OPS Contract Tool\Yearly Report\Yearly Report.xlsx")
Set ws5 = xlBook5.Sheets("Sheet1")
Set ws6 = xlBook6.Sheets("Sheet1")
Set temp = xlBook6.Sheets.Add
 
MsgBox "copy"
xlBook5.Saved = True
xlBook6.Saved = True
xlBook5.Sheets(ws5.Name).Copy xlBook6.Sheets(ws6.Name)  '    <---- ERREUR ICI 
 
 
temp.Name = "temp" 
 
ws6.Name = "DR " & Month(Now()) & " " & Year(Now())
MsgBox "WS6.name = DR....... " & ws6.Name
 
 
temp.Name = "Sheet1"
MsgBox "Temp : " & temp.Name & "ws6 : " & ws6.Name
 
xlbook6.Saved = True 
 
'free 
xlBook5.Close
xlApp5.Quit
Set ws5 = Nothing
Set xlBook5 = Nothing
Set xlApp5 = Nothing
 
 
End If
 
GoTo ws6debut

04/08/2014, 17h36
Philippe Tulliez

Bonjour,
La syntaxe est bonne me semble-t-il. Quel numéro d'erreur as tu à cette ligne ?
Qu'affiche xlBook6.Name et xlBook5.Name ?
Il faut le nom suivi du suffixe (pas le FullName, je pense)
04/08/2014, 21h41
NVCfrm
bonjour,

Le texte de description d'erreur est pourtant explicite.

L'utilisation des goto nécessite une certaine maîtrise du code. Sinon :zekill:

Tu envois dans un gestionnaire pour traiter une erreur. Connais-tu la ligne source d'erreur ?
A la première ligne de ton errorws6, place un point d'arrêt en dur
Code:

1 2 Stop Resume
Pas à pas avec F8 pour identifier ta ligne.

Par ailleurs, il me semble que ta procédure n'a pas prévue de sortie.
Elle boucle sur GoTo ws6debut, alors que tu n'as pas un Exit Sub précédent ton errorws6 quand tout se passe bien.
Ce qui fait que l'exécution continue après libération de ton instance et de tes variables il me semble.
05/08/2014, 09h59
slaim
Bonjour,

Merci pour vos réponses!

@NVCfrm

L'erreur provient bien du xlBook5.Sheets(ws5.Name).Copy xlBook6.Sheets(ws6.Name)
Si je mets en commentaire cette ligne le programme fonctionne sans problème.

Cependant, le problème rentre dans le cas errorsw6 au moment de:
Code:

1 2 name_Sheet = "DR " & Month(Now()) & " " & Year(Now()) Set ws6 = xlBook6.Sheets(name_Sheet)
Car le nom n'existe pas encore donc je le crée dans le cas erreur et je copie les données de l'autre classeur excel.
Je ne sais pas si c'est le meilleur moyen pour envisager le fait de changer de mois donc de feuille ou remplir le yearly planning.

Ce n'est qu'une partie du code. Il y a bien un end Sub.

@Philippe Tulliez
Code:

1 2 3 xlbook5.name = "Yearly Report.xlsx" xlbook6.name = "2014 Client - Yearly Planning.xlsx"
Il n'y a pas de problème sur ça non plus je pense car c'est bien les classeurs sur lesquels je veux travailler.
05/08/2014, 10h22
Philippe Tulliez

Bonjour,

Citation:

L'erreur provient bien du xlBook5.Sheets(ws5.Name).Copy xlBook6.Sheets(ws6.Name)
Si je met en commentaire cette ligne le programme fonctionne sans pb.

:P
C'est assez curieux de trouver qu'un programme fonctionne sans problème si on court-circuite la ligne la plus importante de la procédure.
Que veux-tu faire exactement, car tenter de copier un classeur qui n'existe pas encore ne fonctionnera jamais.

Haha, en effet. Je voulais plutôt dire que c'était bien ici qu'il y avait une erreur.
Le classeur "Yearly Template" existe dans tout les cas et le second est crée par le programme (dans la partie gestion d'erreur, errorhandler).

Je vous colle toute la procèdure, je pense que cela vous aidera à mieux comprendre....

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
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
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
Private Sub CommandButton2_Click()
 
 
    Dim xlApp6 As New Excel.Application
    Dim xlBook6 As New Excel.Workbook
    Dim ws6 As New Excel.Worksheet
 
    Dim xlApp2 As New Excel.Application
    Dim xlBook2 As New Excel.Workbook
    Dim ws2 As New Excel.Worksheet
 
    Dim i As Integer 'Ligne counter
    Dim j As Integer
    Dim n_Name As String 'name operator
    Dim dd As String       ' dday of work
    Dim Inv As String
    Dim max_iter As String  'OVERFLOW count
 
 
    Dim m_month As Integer
    Dim y_year As Integer
 
    Dim name_Sheet As String
 
    m_month = Month(Now())
    y_year = Year(Now())
    max_iter = 0
 
    On Error GoTo errorhandler
 
debut:      'OPEN THE BOOK: ON ERROR (CANNOT FIND THE BOOK) --> CREATE IT
 
    '1) Open the right file
    MsgBox "error 1 "
    Path = y_year & " " & Client & " -Yearly Planning " & ".xlsx"
    'MsgBox "Path save: " & Path 'check the name
    'Link the path
    MsgBox "error 2 "
    Set xlBook6 = xlApp6.Workbooks.Open("C:\OPS Contract Tool\Yearly Report\" & Path)
    'MsgBox "xlbook6 end"
    'Read the right sheet
    MsgBox "error 3"
 
    On Error GoTo errorws6:
 
ws6debut:
 
    MsgBox "WS6 DEBUT"
 
 
    name_Sheet = "DR " & Month(Now()) & " " & Year(Now())
    Set ws6 = xlBook6.Sheets(name_Sheet)
 
 
 
    MsgBox "ws6 name " & ws6.Name
 
    xlApp6.Visible = True
 
    '___________________________________________________________________________________________
    
    MsgBox "Link OP"
    Set xlBook2 = xlApp2.Workbooks.Open("C:\OPS Contract Tool\Ops Contract Tool.xlsm")
    Set ws2 = xlBook2.Sheets("Operator")
    '___________________________________________________________________________________________
    
    '-_-_-_-_-_-_ algo
    '-_-_- First case: Bg: IF BG/ADV... true then name is in the top of the file
    '-_-_- case 2: Sort by Place then Position (use right(last 3 carac of the cell)) and then place the name if it's not already entered
 
    'searching for his name in the sheet operator________________________________________________
    i = 1
    While ws2.Cells(i, 1) <> id_op
    i = i + 1
 
    Wend
    n_Name = ws2.Cells(i, 9)
    '____________________________________________________________________________________________
 
    'Save the name__________________________________
    j = 1
    Inv = n_Name & " " & Position
 
 
    '-_-_- SAVE THE DATE
    dd = Left(d_Date2, 2)
 
    MsgBox "Select case begin"
 
    Select Case Position
 
 
        Case "FST", "JUMPER"
 
 
        i = 15
case1:
        While ws6.Cells(i, 1) <> "FST & JUMPER"                  '-_-_ Looking for the right line
 
        i = i + 1
        'MsgBox ws6.Cells(i, 1)
        'max_iter = i
        'If max_iter = 50 Then
        '    MsgBox "overflow"
        '    GoTo endp
        'End If
 
        Wend
 
        Do While Not IsEmpty(ws6.Cells(i, 1))
            ''MsgBox "strcomp :" & StrComp(Inv, ws6.Cells(i, 1), vbTextCompare)
 
            If StrComp(Inv, ws6.Cells(i, 1), vbTextCompare) = 0 Then
 
                'MsgBox "Inv egal"
                ws6.Cells(i, 1) = Inv
                ws6.Cells(i, Val(dd) + 1) = "1"
                ws6.Cells(i, Val(dd) + 1).Interior.ColorIndex = 6
                If State = "Travel" Then
 
                    ws6.Cells(i, Val(dd) + 1).Interior.ColorIndex = 4
                    ElseIf Prevision = True Then
 
                    ws6.Cells(i, Val(dd) + 1).Interior.Color = vbRed
                End If
 
 
                ws6.Cells(i, Val(dd) + 1).Borders.Weight = 1
 
 
                Exit Do
            End If
            i = i + 1
 
 
        Loop
 
        If IsEmpty(ws6.Cells(i, 1)) Then
            'MsgBox "Vide"
            ws6.Cells(i, 1).EntireRow.Insert
            ws6.Cells(i, Val(dd) + 1).EntireRow.Interior.Color = xlNone
            ws6.Cells(i, 1) = Inv
            ws6.Cells(i, Val(dd) + 1) = "1"
            ws6.Cells(i, Val(dd) + 1).Interior.ColorIndex = 6
 
            If State = "Travel" Then
 
                ws6.Cells(i, Val(dd) + 1).Interior.ColorIndex = 4
                ElseIf Prevision = True Then
 
                ws6.Cells(i, Val(dd) + 1).Interior.Color = vbRed
            End If
 
 
            ws6.Cells(i, Val(dd) + 1).Borders.Weight = 1
 
 
 
        End If
 
 
 
        Case "BG", "BG TD", "ADV", "PA", "PA TD"
 
        'MsgBox "BG TD ADV"
        i = 3
        'MsgBox "Cells = " & ws6.Cells(i, 1)
        Do While StrComp("Skorpios", ws6.Cells(i, 1), vbTextCompare) <> 0
            'MsgBox "strcomp :" & StrComp(ws6.Cells(i, 1), "Skorpios", vbTextCompare) & " i = " & i & " Cells = " & ws6.Cells(i, 1)
 
            If StrComp(Inv, ws6.Cells(i, 1), vbTextCompare) = 0 Then
 
                ' MsgBox "Inv egal"
                ws6.Cells(i, 1) = Inv
                ws6.Cells(i, Val(dd) + 1) = "1"
                ws6.Cells(i, Val(dd) + 1).Interior.ColorIndex = 6
 
                If State = "Travel" Then
 
                    ws6.Cells(i, Val(dd) + 1).Interior.ColorIndex = 4
                    ElseIf Prevision = True Then
 
                    ws6.Cells(i, Val(dd) + 1).Interior.Color = vbRed
                End If
                ws6.Cells(i, Val(dd) + 1).Borders.Weight = 1
 
                Exit Do
            End If
            i = i + 1
 
 
        Loop
 
        If StrComp(Inv, ws6.Cells(i, 1), vbTextCompare) <> 0 Then
            '  MsgBox "Vide"
 
            ws6.Cells(i, 1).EntireRow.Insert
            ws6.Cells(i, Val(dd) + 1).EntireRow.Interior.Color = xlNone
            ws6.Cells(i, 1) = Inv
            ws6.Cells(i, Val(dd) + 1) = "1"
            ws6.Cells(i, Val(dd) + 1).Interior.ColorIndex = 6
 
            If State = "Travel" Then
                ws6.Cells(i, Val(dd) + 1) = "1"
                ws6.Cells(i, Val(dd) + 1).Interior.ColorIndex = 4
                ElseIf Prevision = True Then
                ws6.Cells(i, Val(dd) + 1) = "P"
                ws6.Cells(i, Val(dd) + 1).Interior.Color = vbRed
            End If
 
            ws6.Cells(i, Val(dd) + 1).Borders.Weight = 1
 
 
 
        End If
 
 
        Case Else
 
 
        'MsgBox "Else"
        If Place <> "" Then
 
            i = 2
            Do While StrComp(ws6.Cells(i, 1), Place, vbTextCompare) <> 0  'Looking for the place in the table
                ' MsgBox "while 1 else"
                ' MsgBox "StrComp: " & StrComp(Place, ws6.Cells(i, 1), vbTextCompare) & "   i =  " & i
                i = i + 1
 
            Loop
 
            Do While StrComp(ws6.Cells(i, 1), "_") <> 0                      'Looking for the last carac "_"
 
                If StrComp(Inv, ws6.Cells(i, 1), vbTextCompare) = 0 Then    'if we find the Inv we update the table with the value without inserting a line
 
                '  MsgBox "Inv egal"
                ws6.Cells(i, 1) = Inv
                ws6.Cells(i, Val(dd) + 1) = "1"
                ws6.Cells(i, Val(dd) + 1).Interior.ColorIndex = 6
 
                If State = "Travel" Then
 
                    ws6.Cells(i, Val(dd) + 1).Interior.ColorIndex = 4
                    ElseIf Prevision = True Then
 
                    ws6.Cells(i, Val(dd) + 1).Interior.Color = vbRed
                End If
                ws6.Cells(i, Val(dd) + 1).Borders.Weight = 1
 
                Exit Do                                                 'if we have found it we exit the loop
            End If
            i = i + 1
 
        Loop
 
                'at the end of the loop we test why it has exited
 
                If StrComp(Inv, ws6.Cells(i, 1), vbTextCompare) <> 0 Then       'we exited the loop because we didn't find Inv so we write it with an insert line
                'MsgBox "Vide"
 
                    ws6.Cells(i, 1).EntireRow.Insert
                    ws6.Cells(i, Val(dd) + 1).EntireRow.Interior.Color = xlNone
                    ws6.Cells(i, 1) = Inv
                    ws6.Cells(i, Val(dd) + 1) = "1"
                    ws6.Cells(i, Val(dd) + 1).Interior.ColorIndex = 6
 
                    If State = "Travel" Then                                        'Test for the State and if it's a previson
                    ws6.Cells(i, Val(dd) + 1) = "T"
                    ws6.Cells(i, Val(dd) + 1).Interior.ColorIndex = 4
                    ElseIf Prevision = True Then
                    ws6.Cells(i, Val(dd) + 1) = "P"
                    ws6.Cells(i, Val(dd) + 1).Interior.Color = vbRed
 
                End If
 
            ws6.Cells(i, Val(dd) + 1).Borders.Weight = 1
 
 
 
            End If
 
    Else
 
 
        '-_-_-_-_- If the client is office we create an other kind of table. we erase the template by hiding the others places and then we write at the top of the doc
 
        If Client = "OFFICE" Then
 
            ws6.Range("A3:A14").EntireRow.Hidden = True
            GoTo case1
 
        Else
            GoTo case1
        End If
 
 
    End If
 
 
End Select
 
MsgBox "end select"
 
'____________________________________________________________________________________________
 
'
ws6.Range("B1:AI2").ColumnWidth = 2.5
 
'_______________________________________Save_______________________________________________
 
xlBook6.SaveAs ("C:\OPS Contract Tool\Yearly Report\" & Path)
 
'________Close app and free memory __________________________________________________________
 
xlBook6.Close
xlApp6.Quit
Set ws6 = Nothing
Set xlBook6 = Nothing
Set xlApp6 = Nothing
 
xlBook2.Close
xlApp2.Quit
Set ws2 = Nothing
Set xlBook2 = Nothing
Set xlApp2 = Nothing
 
GoTo endp
 
 
 
errorhandler:
 
MsgBox Err.number
 
        Dim xlApp5 As New Excel.Application
        Dim xlBook5 As New Excel.Workbook
        Dim ws5 As New Excel.Worksheet
        Dim temp As New Excel.Worksheet
 
If Err.number = 1004 Then
 
 
        MsgBox "here"
        Set xlBook5 = xlApp5.Workbooks.Open("C:\OPS Contract Tool\Yearly Report\Yearly Report.xlsx")
        MsgBox "add"
        Set ws5 = xlBook5.Sheets("Sheet1")
        Set temp = xlBook5.Sheets.Add
        MsgBox "fin add"
 
        temp.Name = "temp"
 
        MsgBox "error 4 "
        ws5.Name = "DR " & Month(Now()) & " " & Year(Now())
 
        temp.Name = "Sheet1"
        'ws5.Name = "wesh"
        MsgBox "Temp : " & temp.Name & "ws5 : " & ws5.Name
 
        xlBook5.SaveAs ("C:\OPS Contract Tool\Yearly Report\" & Path)
 
 
        xlBook5.Close
        xlApp5.Quit
        Set ws5 = Nothing
        Set xlBook5 = Nothing
        Set xlApp5 = Nothing
 
    End If
    GoTo debut
 
errorws6:
 
Stop
Resume
 Dim cmpt As Integer
 Dim icounter As Integer
 
    If Err.number = 9 Then
 
        MsgBox "Error number 9"
 
        Set xlBook5 = xlApp5.Workbooks.Open("C:\OPS Contract Tool\Yearly Report\Yearly Report.xlsx")
        Set ws5 = xlBook5.Sheets("Sheet1")
        Set ws6 = xlBook6.Sheets("Sheet1")
        Set temp = xlBook6.Sheets.Add
 
        MsgBox "copy"
        xlBook5.Saved = True
        xlBook6.Saved = True
 
 
        MsgBox "xlbook5 : " & xlBook5.Name & " / xlbook6 : " & xlBook6.Name
 
        xlBook5.Sheets(ws5.Name).Copy xlBook6.Sheets(ws6.Name)
 
        temp.Name = "temp"
 
        MsgBox "WS6.name = DR.......  " & ws6.Name
        ws6.Name = "DR " & Month(Now()) & " " & Year(Now())
 
        temp.Name = "Sheet1"
        MsgBox "Temp : " & temp.Name & "ws6 : " & ws6.Name
 
        'Fill the new sheet with the info of the template doc
 
 
        'xlBook5.Sheets(ws5.Name).Cells.Copy xlbook6.Sheets(ws6.Name).Range("A1")
       ' xlbook6.Save
        'ws5.Range("A1:AF17").Copy ws6.Range("A1:AF17")
 
 
        xlBook5.Close
        xlApp5.Quit
        Set ws5 = Nothing
        Set xlBook5 = Nothing
        Set xlApp5 = Nothing
 
        'xlbook6.SaveAs
 
        End If
 
    GoTo ws6debut
 
 
endp:
 
 
End Sub

Je cherche à entrer une donnée date dans une feuille et chaque mois une nouvelle feuille est créée sous le nom de "DR mois année".

La feuille se crée à partir d'un partron comportant un format spécial en dur.

Donc je choisi un classeur pour chaque client.
S'il n'existe pas je le crée dans errorhandler et je reviens au début du pgm.
Je choisi la feuille correspondant au mois.
Si elle n'existe pas je la crée dans errorsw6 ==> je copie sheet1 de yearly report dans la feuille sheet1 de sw6.
C'est pour cela que j'utilise aussi temp; afin de tjs garder sheet1 comme feuilel de départ. Ensuite un swap pour changer de nom en "DR mois année" et sauvegarder sheet1.
Ensuite je reviens au début de l'erreur.
Si tout se passe bien je vais dans end sub avec goto enp:

... voilà!

N'hésitez pas à me dire si vous avez besoin plus d'inforamtions!

Bonjour,
ton code est tout simplement horrible avec ces sous routines :aie:... et ces goto incompréhensibles complexifiant une affaire simple.:weird:
Tu ne pourras pas le déboguer facilement à moins d'ajouter à la complexité. 8O
Première chose à envisager :
Vire tous les goto qui ne servent à rien, en créant des sub séparées pour des besoins précis tels que:
Code:

1 2 3 4 5 Sub createXLBook2() ... Sub copy_ws5() ....
je n'utilise pratiquement un Goto que pour mettre fin proprement à un programme qui ne peut continuer pour une raison majeure.
Pour vérifier l'existence d'un fichier, il y pleins de techniques qui te dispensent ces instanciations inutiles.
Et pour traiter les erreurs, rien de mieux que:
Code:

1 2 3 4 5 6 7 8 9 On Error Resume Next ' retardement de la récupération d'erreur 'Instructions susceptibles ici ... If Err Then ... On Error GoTo 0 ' Désactive le gestionnaire d'erreurs. 'La prochaine erreur ne sera pas recupéré. Evitera de continuer sur une erreur.
est encore plus souple.
Une fois ton code ventilé et bien reconstruit, tu pourras mieux comprendre et pressentir les problèmes potentiels.

05/08/2014, 13h17
slaim

Merci,

C'est exactement là ou j'ai du soucis avec le VBA, c'est que je n'ai jamais réussi à tester si un fichier était bien ouvert ou pas.
Je n'avais pas pensé au resume next et ensuite un test avec un if err.number = 1000...

Merci je vais faire ça!

Bonjour,
Voici une petite fonction sans prétention qui te permet de vérifier si un classeur est ouvert

Code:

1
2
3
4
5
6
7
8
Function IsWorkbookOpen(wkbName As String) As Boolean
 ' Fonction renvoyant True si le classeur dont le nom est passé en argument est ouvert
 ' Argument wkbNAme de type string est le nom du classeur à vérifier (Nom + Suffixe)
 Dim wkb As Workbook
 On Error Resume Next: Set wkb = Workbooks(wkbName)
 If Not wkb Is Nothing Then IsWorkbookOpen = True
 Set wkb = Nothing: On Error GoTo 0
End Function

Lost episode 2 S1

Hello!

Voici ma fonction createXlsheet... J'ai tjs des erreurs au niveau de la copie. Je ne pense pas me tromper sur la syntaxe car lors du test je vois que la copie se fait pas le collage "paste".
Je ne comprend pas car je peux écrire sur la feuille, donc le book existe vrmt. De plus lors du test : MsgBox "book names : " & wBook.Name & " / " & xlbook5.Name : J'ai bien les bon noms de classeurs...

Err.number me renvoie 0 donc pas d'erreurs... Alors bien évidemment il doit y en avoir une énorme!!

Merci d'avance pour votre aide,

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Public Function createXlsheet6(wBook As Workbook, p_Path As String)
 
    MsgBox "createxlsheet6"
    Dim xlapp5 As New Excel.Application
    Dim xlbook5 As New Excel.Workbook
    Dim ws5 As New Excel.Worksheet
 
    Dim sheet As Excel.Worksheet
    Dim temp As New Excel.Worksheet
    Dim i As Integer
 
    'Select the right Destination sheet
    Set sheet = wBook.Sheets("Sheet1")
 
    'Open the template book
    Set xlbook5 = xlapp5.Workbooks.Open("C:\OPS Contract Tool\Yearly Report\Yearly Report.xlsx")
    Set ws5 = xlbook5.Sheets("Sheet1")
 
    'Check if its the right file
    MsgBox "book names : " & wBook.Name & " / " & xlbook5.Name
 
 
    'Copy data from xlbook5 to wbook
   ' xlbook5.Worksheets("Sheet1").Copy _
   ' Destination:=wBook.Worksheets("Sheet1")
 
   xlbook5.Worksheets("Sheet1").Select
   Selection.Copy
 
   sheet.Cells(1, 1) = "TEST"        'ça marche, ça écrit...
   wBook.sheet.Paste   'Stop / Resume : Saute cette ligne, pb ici
 
 
    'Rename
    Set temp = wBook.Sheets.Add
    sheet.Name = "DR " & Month(Now()) & " " & Year(Now())
    temp.Name = "Sheet1"
 
 
 
    'Save work
    wBook.SaveAs ("C:\OPS Contract Tool\Yearly Report\" & p_Path)
 
 
    xlbook5.Close
    xlapp5.Quit
    Set ws5 = Nothing
    Set xlbook5 = Nothing
    Set xlapp5 = Nothing
 
End Function

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
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
Private Sub CommandButton2_Click()
 
 
    Dim xlApp6 As New Excel.Application
    Dim xlBook6 As New Excel.Workbook
    Dim ws6 As New Excel.Worksheet
 
    Dim xlApp2 As New Excel.Application
    Dim xlBook2 As New Excel.Workbook
    Dim ws2 As New Excel.Worksheet
 
    Dim i As Integer 'Ligne counter
    Dim j As Integer
    Dim n_Name As String 'name operator
    Dim dd As String       ' dday of work
    Dim Inv As String
    Dim max_iter As String  'OVERFLOW count
 
 
    Dim m_month As Integer
    Dim y_year As Integer
 
    Dim name_Sheet As String
 
    Dim res As Integer
 
 
    m_month = Month(Now())
    y_year = Year(Now())
    max_iter = 0
 
 
 
On Error Resume Next
 
Stop
Resume
 
    Path = y_year & " " & Client & " - Yearly Planning " & ".xlsx"
    Set xlBook6 = xlApp6.Workbooks.Open("C:\OPS Contract Tool\Yearly Report\" & Path)
    'MsgBox "xlbook6 = " & xlBook6.Name
    If Err.number = 1004 Then
 
        MsgBox "error number : " & Err.number
        Call createXlbook6(Path)
 
        MsgBox "xlbook6 = " & xlBook6.Name
    End If
 
 On Error GoTo 0
 
 On Error Resume Next
 
    name_Sheet = "DR " & Month(Now()) & " " & Year(Now())
 
    Set ws6 = xlBook6.Sheets("Sheet1")
 
    MsgBox "error num " & Err.number
 
    If xlBook6.Sheets(name_Sheet) Is Nothing Then
 
        MsgBox "Sheet does not exist"
        Call createXlsheet6(xlBook6, Path)
 
    End If
    Set ws6 = xlBook6.Sheets(name_Sheet)
On Error GoTo 0
...
... 'Application
...
...
 
 
End sub

06/08/2014, 17h55
NVCfrm

salut,
Que dire ?
Le code évolue, mais est toujours ... bad :aie:
(note évolue comme un compliment et bad comme une incitation à mieux faire)

Pour un début, on peut passer.
Tes déclarations d'instanciations sont nombreuses, et parfois inutiles.

Je te signales que tu ne peux pas ouvrir un classeur dans une nouvelle instance d'excel et copier ces données dans l'instance en cours avec la methode Copy.:)
Et je crois que toute ta difficulté se résume à ce détail, ;) bien que j'ai pas approfondi l'analyse.
Est-il utile d'ouvrir ton WorkBook dans une nouvelle instance ?
06/08/2014, 18h59
Marc-L

Bonjour,

et oserais-je affirmer l'inutilité de la méthode Paste, rien qu'en consultant l'aide VBA intégrée de la méthode Copy ?‼
07/08/2014, 09h56
slaim

Citation:

Envoyé par Marc-L

Bonjour,

et oserais-je affirmer l'inutilité de la méthode Paste, rien qu'en consultant l'aide VBA intégrée de la méthode Copy ?‼

Oui je sais, j'ai fait plusieurs test avec copy seule et ensuite copy paste, aucune ne marche. Cela m'a montré que la copy fonctionnait mais pas le paste donc je vois que c'est l'utilisation de mon classeur qui n'est pas possible ici, comme NVCfrm l'a dit.

@NVCfrm: Merci, la déclaration du i est vrmt du n'importe quoi,vous as raison, par contre pour l'autre partie du code je n'ai pas tout donné ici car c'est long pour rien et toutes déclarations sont utilisés par la suite. Par contre vraiment si vous avez le temps de regarder le code plus en détails et de me donner vos conseils pour m'améliorer ça serait un plaisir... Je débute vrmt en VBA et je vais surement prendre de mauvaises habitudes!

Pour revenir à ce que vous m'avez dit :

Citation:

Je te signales que tu ne peux pas ouvrir un classeur dans une nouvelle instance d'excel et copier ces données dans l'instance en cours avec la methode Copy.

J'ai pas très bien compris... J'ouvre un classeur "Template" que je copie dans un autre... Je n'ai pas le droit de faire ça? VBA me parait limité alors. Je dois donc tout copier champs par champs? ça marche mais c'est long mais surtout ça me copie pas la mise en forme (S'il existe un truc avec boucle sur i de worksheet.cells(i,1).entirerow <= worksheet2.cells(i,1).entirerow... (je sais que cela est surement faux)

Merci encore!
07/08/2014, 10h56
Philippe Tulliez

Bonjour,

Citation:

J'ai pas très bien compris... J'ouvre un classeur "Template" que je copie dans un autre... Je n'ai pas le droit de faire ça?

Un modèle ne se copie pas sur un autre classeur mais est sauvé en tant que classeur en lui donnant un nom.
Un modèle est un classeur suffixé xlt (version antérieure à 2007) ou xltx, xltm

Citation:

VBA me parait limité alors. Je dois donc tout copier champs par champs?

VBA n'est pas limité et fait tout ce que tu peux faire manuellement avec Excel et bien d'autres choses plus complexes. Encore faut-il bien connaître Excel et les produits office si l'on veut lier Excel avec d'autres produits de cette suite et ensuite bien structurer son application
07/08/2014, 11h28
slaim

Ce n'est pas un modèle à proprement dit

Bonjour Phillipe,

Merci pour votre réponse.
Ce n'est pas un modèle à proprement dit. C'est un classeur excel xslx dont j'essaie de copier la feuille 1 sur une feuille d'un autre classeur. Cette feuille a une mise en page que j'ai fait en dure pour pas la coder à chaque fois sur chaque feuille crée à partir de celui ci.

Citation:

Encore faut-il bien connaître Excel et les produits office si l'on veut lier Excel avec d'autres produits de cette suite et ensuite bien structurer son application

Merci pour ce pic.

Manuellement je peux copier copier une feuille d'un classeur et la mettre dans un autre. Je pensais que Copy faisait ça. Pouvez vous s'il vous plait jettez un oeil à ma fonction réellement svp?

Merci,
07/08/2014, 12h19
Philippe Tulliez

Bonjour,

Citation:

Manuellement je peux copier copier une feuille d'un classeur et la mettre dans un autre. Je pensais que Copy faisait ça

Tout ce que tu fais manuellement dans excel, VBA peux le faire.
Fais des tests, tu prends une petite plage de cellules où tu places des formats divers et éventuellement des formules et copie cette plage d'abord sur la même feuille et ensuite sur une autre en les plaçant côte à côte pour bien visualiser ce qui se passe.
Structure ton code en plusieurs procédures et éventuellement en plusieurs modules, c'est la meilleures façons de procéder. Ainsi tu peux tester une procédures et quand c'est elle fonctionne, tu passes à une autre.
Une application est constituée de plusieurs choses donc en découpant les tâches tu te facilites la vie et surtout la maintenance.
07/08/2014, 12h21
NVCfrm

Bonjour,

Citation:

Manuellement je peux copier copier une feuille d'un classeur et la mettre dans un autre. Je pensais que Copy faisait ça. Pouvez vous s'il vous plait jettez un oeil à ma fonction réellement svp?

Ce n'est pas ce que tu fais dans ton code.
Pour illustrer manuellement ce que tu fais :
Ouvre Excel dans les raccourcis Menu Démarrer avec le classeur contenant ton programme. Repète la même opération pour le classeur de donnée à copier.
En ce moment tu as deux instances qui occupent 2 zones mémoires complètement indépendantes.
Tu peux tenter de copier d'une instance vers une autre sans succès. A moins de ne transiter par le presse-papier Windows différent du presse-papier Office.
Chacune a ses propres applications y compris le presse-papier Office.

Tes déclarations ...New Excel.Application ont pour effet à l'utilisation de créer une autre instance Excel comme décrit ci-dessus.
Or pour l'opération que tu veux réaliser, tu n'as pas besoin d'ouvrir ton WorkBook en instanciant un autre Excel.
Tu peux le faire directement.

Pour approfondir tes connaissances du VBA Excel, il y a d'excellents tutos sur le site.
Je veux bien jeter un coup d'œil plus patient sur ton code en fonction de mes disponibilités pour l'épurer un petit peu, si d'autres ne le font avant.
07/08/2014, 14h48
slaim

@NVCfrm

Merci encore pour votre contribution. Je pense avoir saisi ce que vous voulez dire mais sincèrement je fais des tests et j'ai tjs des erreurs et j'ai du mal à trouver des exemples.
Votre aide serait fortement apprécié!

J'étudie aussi les "tuto" du site.

@Philippe Tulliez

Oui Cela a déjà été fait, le test avec données copiées sur le même classeur fonctionnent. Je n'ai pas besoin de le séparer en module ici, c'est très court. NVCfrm a touché je pense le pb de mon application, elle se trouve dans l'instanciation de mes classeurs.
07/08/2014, 15h04
NVCfrm

re,
L'enregistreur macro est là pour te donner les syntaxes correctes, que tu peux adapter.

tu peux poster l'intégralité de ton code avec les explications utiles.
Je ne garantis rien. Mais il y a pas mal de gens qui peuvent te clarifier ça.
07/08/2014, 15h43
NVCfrm

re,

Je suis parfois très réservé en post de solutions toutes faites.:) Je préfère généralement donner les orientations utiles, te permettant d'avoir le plaisir de solutionner par toi même avec les indications.
Déclare tes variables sans les new.
Ouvres ton fichier directement avec WorkBook.Open sans l'application qui est déjà implicite.
07/08/2014, 16h30
slaim

Oui c'est normal! Je fais de mon mieux pour suivre tes pistes :)
Tu voulais surement dire Workbooks.open?
Surement à demain quand j'aurais un autre truc à proposer!
07/08/2014, 17h27
slaim

Merci

Un grand Merci à NVCfrm.
J'ai beaucoup appris sur le test des ouvertures de classeurs et sur la copie.
Tout marche sans utiliser le New Excel.Application et cela m'a permis de faire le ménage sur mon code.

:rose2: