VBA COPY methode erreur, SVP!

**slaim** · 04/08/2014, 17h22

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!

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

Voici mon 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
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

**Philippe Tulliez** · 04/08/2014, 17h36

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)

**NVCfrm** · 04/08/2014, 21h41

bonjour,

Le texte de description d'erreur est pourtant explicite.

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

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 :

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

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.

**slaim** · 05/08/2014, 09h59

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 :

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

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 :

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

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.

**Philippe Tulliez** · 05/08/2014, 10h22

Bonjour,

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.

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.

**slaim** · 05/08/2014, 10h45

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 :

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
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!

VBA COPY methode erreur, SVP! [XL-2007]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager