[XL-2007] Macro d'insertions de lignes - erreur 1004 [Résolu]

[Pedrocha]

Bonjour,

Je vous contacte au sujet d'une erreur 1004 qui apparaît à l’exécution de ma macro. Mon problème est le suivant : certaines cellules de mon tableau comporte plusieurs lignes càd plusieurs chaines de caractères séparées par un saut de ligne (Chr(10)), et je souhaite "spliter" ces lignes en plusieurs.

Concrètement si j'ai une ligne comme
ligne 1 :
A1 B1 C1
A2 B2 C2

je voudrait obtenir:
ligne 1 :
A1 B1 C1
ligne 2 :
A2 B2 C2

J'ai donc mis en place un algorithme qui stocke toutes la valeurs séparées dans des tableaux, plus insère au fur et à mesure des lignes en mettant les bonnes valeurs. Mon code fonctionne sans problème sur un autre tableau de la même forme mais sur celui-ci rien à faire, l'erreur 1004 apparaît systématiquement avec le code "Selection.Insert Shift:=xlDown".

Après plusieurs tests je crois que ce qui génère l'erreur est la partie "Shift:=xlDown" mais j'ai un peu du mal à comprendre pourquoi.

Le code de ma macro est le suivant :

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
 
Sub spliter()
    Dim titulaireContrat As String
    Dim numDA As String
    Dim numDIG As String
    Dim dateDebutMarche As String
    Dim dateFinMarche As String
    Dim montantCible As String
 
    Dim tabMontants(12) As String
 
    'tableaux dans lesquels sont répartis les différentes valeurs séparées
    Dim tabTitulaireContrat() As String
    ReDim tabTitulaireContrat(1)
 
    Dim tabNumeroContratDA() As String
    Dim tabNumeroContratDIG() As String
    Dim tabDateDebutMarche() As String
    Dim tabDateFinMarche() As String
    Dim tabMontantCible() As String
    Dim tabSeparation() As String
 
    Dim tmpLigne As Range
 
    Dim message As String
    message = ""
 
    'compteur de lignes
    Dim cptLigne As Integer
    cptLigne = 1
 
    'compteur permettant de parcourir les chaines de caractères
    Dim cpt, i As Integer
 
    'compteur d'éléments à séparer
    Dim cptElements As Integer
    cptElements = 0
 
    Dim cptElementsReference As Integer
    cptElementsReference = 0
 
    Dim decalageReference As Integer
    decalageReference = 0
 
    'sous-éléments à séparer
    Dim tmpElement As String
    tmpElement = ""
 
    Dim tmpChar As String
 
    'compteur du nombre d'opérations
    Dim cptAnomalie As Integer
    cptAnomalie = 0
 
    ThisWorkbook.Activate
    Worksheets("Liste").Range("A2").Select
 
    'on vérifie que le tableau est conforme pour ne pas générer d'erreurs pendant le traitement
    If Selection.Value = "UE" Then
        If Selection.Offset(0, 10).Value = "Domaine" Then
            decalageReference = 11
        ElseIf Selection.Offset(0, 11).Value = "Domaine" Then
            decalageReference = 12
        Else
            decalageReference = -1
        End If
 
        'si le tableau est conforme on commence le traitement
        If decalageReference > 0 Then
            Worksheets("Liste").Range("A3").Select
            While Selection.Value <> "" Or Selection.Offset(1, 0).Value <> ""
                Selection.Offset(0, decalageReference).Select
                titulaireContrat = Selection.Value
 
                'on parcourt la cellule caractère par caractère pour récupérer les valeurs séparées par des \n
                'on peut faire des splits mais en l'occurrence ca ne m'arrangait pas du tout
                For cpt = 1 To Len(titulaireContrat)
                    tmpChar = Mid(titulaireContrat, cpt, 1)
 
                    If tmpChar = Chr(10) Then
                        cptElements = cptElements + 1
                        ReDim Preserve tabTitulaireContrat(cptElements + 1)
 
                        If tmpElement = "LOGIDOC SOLUTION (TESSI)" Then
                            tmpElement = "LOGIDOC SOLUTION (TESSI) routage"
                        ElseIf tmpElement = "routage + affranchissement" Then
                            tmpElement = "LOGIDOC SOLUTION (TESSI) affranchissement"
                        End If
 
                        tabTitulaireContrat(cptElements - 1) = tmpElement
                        tmpElement = ""
                    ElseIf cpt = Len(titulaireContrat) And cptElements >= 1 Then
                        cptElements = cptElements + 1
                        message = ""
                        ReDim Preserve tabTitulaireContrat(cptElements)
                        tmpElement = tmpElement + tmpChar
 
                        If tmpElement = "LOGIDOC SOLUTION (TESSI)" Then
                            tmpElement = "LOGIDOC SOLUTION (TESSI) routage"
                        ElseIf tmpElement = "routage+affranchissement" Then
                            tmpElement = "LOGIDOC SOLUTION (TESSI) affranchissement"
                        End If
 
                        tabTitulaireContrat(cptElements - 1) = tmpElement
                    Else
                        tmpElement = tmpElement + tmpChar
                    End If
                Next cpt
 
                ReDim tabNumeroContratDA(cptElements)
                cptElementsReference = cptElements
 
                'On ne fait les traitements que s'il y a plusieurs éléments dans la case de titulaire de contrat
                If cptElements > 1 And UBound(Split(ActiveCell.Offset(0, 1).Value, Chr(10))) <= UBound(tabNumeroContratDA) Then
                    cptAnomalie = cptAnomalie + 1
                    ReDim tabNumeroContratDIG(cptElements)
                    ReDim tabDateDebutMarche(cptElements)
                    ReDim tabDateFinMarche(cptElements)
                    ReDim tabEcheanceOptionUn(cptElements)
                    ReDim tabEcheanceOptionDeux(cptElements)
                    ReDim tabMontantCible(cptElements)
 
                    cptElements = 0
                    tmpElement = ""
 
                    'on recupère le numéro de DA
                    ActiveCell.Offset(0, 1).Select
                    numDA = Selection.Value
 
                    For cpt = 1 To Len(numDA)
                        tmpChar = Mid(numDA, cpt, 1)
                        If tmpChar = Chr(10) Then
                            If UBound(Split(tmpElement, " + ")) <> 0 Then
                                ReDim tabSeparation(UBound(Split(tmpElement, " + ")))
                                tabSeparation = Split(tmpElement, " + ")
                                tmpElement = tabSeparation(0)
                                tabNumeroContratDA(cptElements) = tmpElement
                                cptElements = cptElements + 1
                                tmpElement = tabSeparation(1)
                            End If
                            tabNumeroContratDA(cptElements) = tmpElement
                            cptElements = cptElements + 1
 
                            tmpElement = ""
                        ElseIf cpt = Len(numDA) Then
                            tmpElement = tmpElement + tmpChar
                            tabNumeroContratDA(cptElements) = tmpElement
                            cptElements = cptElements + 1
                        Else
                            tmpElement = tmpElement + tmpChar
                        End If
                    Next cpt
 
                    cptElements = 0
                    tmpElement = ""
 
                    'on recupère le numéro de DIG
                    ActiveCell.Offset(0, 1).Select
                    numDIG = Selection.Value
 
                    For cpt = 1 To Len(numDIG)
                        tmpChar = Mid(numDIG, cpt, 1)
                        If tmpChar = Chr(10) Then
                            If UBound(Split(tmpElement, " + ")) <> 0 Then
                                ReDim tabSeparation(UBound(Split(tmpElement, " + ")))
                                tabSeparation = Split(tmpElement, " + ")
                                tmpElement = tabSeparation(0)
                                tabNumeroContratDIG(cptElements) = tmpElement
                                cptElements = cptElements + 1
                                tmpElement = tabSeparation(1)
                            End If
                            tabNumeroContratDIG(cptElements) = tmpElement
                            cptElements = cptElements + 1
                            tmpElement = ""
                        ElseIf cpt = Len(numDIG) Then
                            tmpElement = tmpElement + tmpChar
                            tabNumeroContratDIG(cptElements) = tmpElement
                            cptElements = cptElements + 1
                        Else
                            tmpElement = tmpElement + tmpChar
                        End If
                    Next cpt
 
                    cptElements = 0
                    tmpElement = ""
 
                    'on recupère la date de début de marché
                    ActiveCell.Offset(0, 1).Select
                    dateDebutMarche = Selection.Value
 
                    For cpt = 1 To Len(dateDebutMarche)
                        tmpChar = Mid(dateDebutMarche, cpt, 1)
                        If tmpChar = Chr(10) Then
                            If UBound(Split(tmpElement, " + ")) <> 0 Then
                                ReDim tabSeparation(UBound(Split(tmpElement, " + ")))
                                tabSeparation = Split(tmpElement, " + ")
                                tmpElement = tabSeparation(0)
                                tabDateDebutMarche(cptElements) = tmpElement
                                cptElements = cptElements + 1
                                tmpElement = tabSeparation(1)
                            End If
                            tabDateDebutMarche(cptElements) = tmpElement
                            cptElements = cptElements + 1
                            tmpElement = ""
                        ElseIf cpt = Len(dateDebutMarche) Then
                            tmpElement = tmpElement + tmpChar
                            tabDateDebutMarche(cptElements) = tmpElement
                            cptElements = cptElements + 1
                        Else
                            tmpElement = tmpElement + tmpChar
                        End If
                    Next cpt
 
                    cptElements = 0
                    tmpElement = ""
 
                    'on recupère la date de fin de marché
                    ActiveCell.Offset(0, 1).Select
                    dateFinMarche = Selection.Value
 
                    For cpt = 1 To Len(dateFinMarche)
                        tmpChar = Mid(dateFinMarche, cpt, 1)
                        If tmpChar = Chr(10) Then
                            tabDateFinMarche(cptElements) = tmpElement
                            cptElements = cptElements + 1
                            tmpElement = ""
                        ElseIf cpt = Len(dateFinMarche) Then
                            tmpElement = tmpElement + tmpChar
                            tabDateFinMarche(cptElements) = tmpElement
                            cptElements = cptElements + 1
                        Else
                            tmpElement = tmpElement + tmpChar
                        End If
                    Next cpt
 
                    cptElements = 0
                    tmpElement = ""
 
                    'on recupère l'écheance de la première option
                    ActiveCell.Offset(0, 1).Select
                    echeanceOptionUn = Selection.Value
 
                    For cpt = 1 To Len(echeanceOptionUn)
                        tmpChar = Mid(echeanceOptionUn, cpt, 1)
                        If tmpChar = Chr(10) Then
                            tabEcheanceOptionUn(cptElements) = tmpElement
                            cptElements = cptElements + 1
                            tmpElement = ""
                        ElseIf cpt = Len(echeanceOptionUn) Then
                            tmpElement = tmpElement + tmpChar
                            tabEcheanceOptionUn(cptElements) = tmpElement
                            cptElements = cptElements + 1
                        Else
                            tmpElement = tmpElement + tmpChar
                        End If
                    Next cpt
 
                    cptElements = 0
                    tmpElement = ""
 
                    'on recupère l'écheance de la deuxième option
                    ActiveCell.Offset(0, 1).Select
                    echeanceOptionDeux = Selection.Value
 
                    For cpt = 1 To Len(echeanceOptionDeux)
                        tmpChar = Mid(echeanceOptionDeux, cpt, 1)
                        If tmpChar = Chr(10) Then
                            tabEcheanceOptionDeux(cptElements) = tmpElement
                            cptElements = cptElements + 1
                            If cpt = Len(echeanceOptionDeux) Then
                                tabEcheanceOptionDeux(cptElements) = ""
                            End If
                            tmpElement = ""
                        ElseIf cpt = Len(echeanceOptionDeux) Then
                            tmpElement = tmpElement + tmpChar
                            tabEcheanceOptionDeux(cptElements) = tmpElement
                            cptElements = cptElements + 1
                        Else
                            tmpElement = tmpElement + tmpChar
                        End If
                    Next cpt
 
                    cptElements = 0
                    tmpElement = ""
 
                    'on recupère le montant cible
                    ActiveCell.Offset(0, 2).Select
                    montantCible = Selection.Value
 
                    For cpt = 1 To Len(montantCible)
                        tmpChar = Mid(montantCible, cpt, 1)
                        If tmpChar = Chr(10) Then
                            tabMontantCible(cptElements) = tmpElement
                            cptElements = cptElements + 1
                            tmpElement = ""
                        ElseIf cpt = Len(montantCible) Then
                            tmpElement = tmpElement + tmpChar
                            tabMontantCible(cptElements) = tmpElement
                            cptElements = cptElements + 1
                        Else
                            tmpElement = tmpElement + tmpChar
                        End If
                    Next cpt
 
                    For cpt = 0 To UBound(tabMontants) - 1
                        tabMontants(cpt) = ActiveCell.Offset(0, cpt + 1).Value
                    Next cpt
 
                    'après avoir récupéré toutes les valeurs on commence l'insertion des lignes
                    For i = cptElementsReference - 1 To 0 Step -1
                        'si c'est la première itération, on sélectionne la ligne courante
                        'on décale les cellules vers le haut et on remonte dans les tableaux de valeur de la même facon
                        If i = cptElementsReference - 1 Then
                            If decalageReference = 12 Then
                                Set tmpLigne = ActiveSheet.Range(ActiveCell, ActiveCell.Offset(0, -20))
                            Else
                                Set tmpLigne = ActiveSheet.Range(ActiveCell, ActiveCell.Offset(0, -19))
                            End If
                            tmpLigne.Select
                        'si ce n'est pas la première itération, on insère une ligne, on attribue à ses cellules les mêmes valeurs que la ligne en dessous
                        ElseIf i < cptElementsReference - 1 Then
                            If decalageReference = 12 Then
                                ActiveSheet.Range("A" & (Selection.Row) & ":AG" & (Selection.Row)).Select
                            Else
                                ActiveSheet.Range("A" & (Selection.Row) & ":AF" & (Selection.Row)).Select
                            End If
                            'c'est cette ligne qui pose problème, à un certain rang une erreur 1004 apparaît
                            'plus précisément, il semblerait que c'est le Shift:=xlDown qui génère l'erreur
                            Selection.Insert Shift:=xlDown
                            Selection.Value = Selection.Offset(1, 0).Value
                        End If
 
                        'on modifie les cellules de la ligne courante
                        'si c'est la première itération, ce sont les valeurs de la dernière valeurs des différents tableaux
                        'sinon, c'est la valeur de l'itération en cours
                        Selection.Cells(1, decalageReference + 1).Value = tabTitulaireContrat(i)
                        Selection.Cells(1, decalageReference + 2).Value = tabNumeroContratDA(i)
                        Selection.Cells(1, decalageReference + 3).Value = tabNumeroContratDIG(i)
                        Selection.Cells(1, decalageReference + 4).Value = tabDateDebutMarche(i)
                        Selection.Cells(1, decalageReference + 5).Value = tabDateFinMarche(i)
                        Selection.Cells(1, decalageReference + 6).Value = tabEcheanceOptionUn(i)
                        Selection.Cells(1, decalageReference + 7).Value = tabEcheanceOptionDeux(i)
 
                        'on fonction du nombre de valeurs détéctées dans la celulle du montant, on met une valeur différente
                        If cptElements > 1 Then
                            Selection.Cells(1, decalageReference + 9).Value = tabMontantCible(i)
                        ElseIf cptElements = 1 And i = 0 Then
                            Selection.Cells(1, decalageReference + 9).Value = montantCible
                        Else
                            Selection.Cells(1, decalageReference + 9).Value = ""
                        End If
 
                        'si on est à la dernière itération, on met les valeurs du tableau, sinon on met les valeurs à ""
                        If i = 0 Then
                            For cpt = 0 To UBound(tabMontants) - 1
                                Selection.Cells(1, decalageReference + 10 + cpt).Value = tabMontants(cpt)
                            Next cpt
                        Else
                            If decalageReference = 12 Then
                                ActiveSheet.Range("V" & (Selection.Row) & ":AG" & (Selection.Row)).Value = ""
                            Else
                                ActiveSheet.Range("U" & (Selection.Row) & ":AF" & (Selection.Row)).Value = ""
                            End If
                        End If
 
                        'on incrémente le nombre de lignes
                        If i < cptElementsReference - 1 Then
                            cptLigne = cptLigne + 1
                        End If
                    Next i
 
                    'enfin on se place sur la première cellule de la première ligne après celle que l'on vient de traiter
                    ActiveSheet.Range("A" & cptLigne + 2).Select
                Else
                    's'il n'y a rien à séparer dans la ligne, on passe à la ligne suivante
                    Selection.Offset(cptElements + 1, -decalageReference).Select
                End If
 
                'on vide les tableaux
                Erase tabTitulaireContrat
                Erase tabNumeroContratDA
                Erase tabNumeroContratDIG
                Erase tabDateDebutMarche
                Erase tabDateFinMarche
                Erase tabMontantCible
                Erase tabMontants
 
                'on réinitialise les compteurs
                cptElements = 0
                tmpElement = ""
 
                'on incrémente le nombre de lignes
                cptLigne = cptLigne + 1
            Wend
 
            message = "Fin du traitement, " & cptAnomalie & " ont été traitées."
        Else
            message = "Attention, la structure de ce tableau ne convient pas"
        End If
    Else
        message = "Attention, veuillez sélectionner la première valeur du tableau"
    End If
    MsgBox message
End Sub

Ce n'est certainement par le code le plus efficace et le moins brouillon mais il avait au moins le mérite de fonctionner.

Quelqu'un aurait-il une idée pour résoudre mon problème svp ?

Je vous remercie d'avance pour votre patience.

Cordialement,

Pierre

[francky74]

Bonjour,

Quelle est le numéro de ligne où se situe ton erreur ?
Ton fichier comporte plus de 400 lignes ...

Merci

[Daniel.C]

Bonjour,

Quel est le libellé du message d'erreur ?

[Pedrocha]

Bonjour,

L'erreur se déclenche à ligne 180 du tableau (qui en fait presque 1500). Le libellé de mon message d'erreur est :

Erreur d’exécution '1004':
Erreur définie par l'application ou par l'objet

C'est vraiment étrange car une ligne quasi-identique est bien traitée au dessus.

Merci pour votre aide.

Pierre

[francky74]

Bonjour,

Je voulais dire, a quelle N° de ligne, dans le code, VBA s'arrête-t-il ?
Le code que vous avez fourni comporte 404 lignes.

[Pedrocha]

L'erreur apparaissait juste après "exécution" de la ligne 329. J'ai fini par avoir l'erreur dès la première ligne alors je me suis dis qu'il y avait peut-être un problème avec ma feuille (que je remplaçais toujours par la même feuille d'origine). Après copie du code dans un nouveau classeur tout propre cela fonctionne et me voilà rassuré. Je ne sais pas trop ce qui posait problème mais je saurai à l'avenir qu'il faut faire attention à ne pas faire des copier/coller dans tous les sens pour finir par se planter.

Merci beaucoup pour votre patience et pour la rapidité de vos réponses.

Pierre