Fusionner des fichiers Excel jumeaux

Version imprimable

29/10/2015, 10h35
Invité

Fusionner des fichiers Excel jumeaux

Bonjour ,

Dans un répertoire Excel j'ai une une vingtaine de fichiers Excel (xls ET xlsx). Ces fichiers correspondent à des saisies d'agents. Chaque fichier est bati de la même façon.

> 2 onglets (onglet A c'est pour les clients de type A , onglet B pour les clients de type B). L'agent qui saisit n'a d'autre choix que ces 2 onglets.

J'ai un fichier supplèmentaire ou j'ai les entêtes. Le fichier d'entêtes à la même structure sauf qu'il n'a que les entêtes.

A savoir le nombre de ligne des saisies agent n'est pas connu. Donc le nombre de ligne fluctue. Il y a une dizaine de colonnes. Sur les fichiers de saisies agent j'enlève les entêtes de colonnes. Les fichiers sont nettoyés avant traitement.

Le but est de fusionner les traitements de type A d'en 1 fichier A et de type B dans un fichier B.

Pour résumer >

fichier_entete.xls (onglet_A , onglet_B)
fichier_agent1.xls (onglet_A , onglet_B)
fichier_agent2.xlsx (onglet_A , onglet_B)
fichier_agent3.xls (onglet_A , onglet_B)
fichier_agent4.xls (onglet_A , onglet_B)
fichier_agent5.xlsx (onglet_A , onglet_B)
fichier_agent6.xlsx (onglet_A , onglet_B)
fichier_agent7.xls (onglet_A , onglet_B)
fichier_agent8.xlsx (onglet_A , onglet_B)
fichier_agent9.xls (onglet_A , onglet_B)
fichier_agent10.xls (onglet_A , onglet_B)
...

au final j'ai >

fichier_typeA (onglet_A)
fichier_typeB (onglet_B)

Ici je me suis inspiré de ce qui se fait en ligne de commande avec la commande "type > et >>" pour fusionner des fichiers csv ou txt de données brutes entre eux dans un même fichier.

Sauf qu'ici je dois passer par le VBA.

Je ne sais pas si je dois lancer une ou deux macro pour chaque fichier (A et B).

Merci de m'aiguiller .

Je bricole quelque chose pour correction.

Bonjour,

Une piste. Les classeurs son censés être ouverts et les noms de feuilles identiques (pour le test c'est "onglet_A", il suffit de faire pareil dans le classeur concerné pour "onglet_B") :

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
 
Sub Test()
 
    Dim Cls As Workbook
    Dim Plage As Range
    Dim DerLgn As Long
    Dim NomFeuille As String
 
    NomFeuille = "onglet_A"
 
    'boucle sur les classeurs ouverts
    For Each Cls In Workbooks
 
        'évite ce classeur-ci (celui qui a la macro et que doit recevoir les données)
        If Cls.Name <> ThisWorkbook.Name Then
 
            'défini la plage à partir de A1
            Set Plage = Cls.Worksheets(NomFeuille).Range("A1").CurrentRegion
 
            'ajoute les valeurs sous les entêtes et les unes à la suite des autres
            With ThisWorkbook.Worksheets(NomFeuille)
 
                DerLgn = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 'sur colonne A
                .Range(.Cells(DerLgn, 1), .Cells(DerLgn - 1 + Plage.Rows.Count, Plage.Columns.Count)).Value = Plage.Value
 
            End With
 
        End If
 
    Next Cls
 
End Sub

29/10/2015, 17h23
Invité

Bonjour,
En fait de piste en voilà une autre http://www.developpez.net/forums/d15...e/#post8404415

Bonjour,

Voici mon code avec mes 4 fichiers à compacter par "onglet" (dont un fichier entête) >>

1 fichier final avec tous les onglets A
1 fichier final avec tous les onglets B

J'ai repris le code donné par Theze mais celui ci ne fonctionne pas . :(

J'ai un message "erreur d'exécution 9 l'indice n'appartient pas à la sélection" ou bien "l'indice n'appartient pas à la sélection" :weird: . VBA veut que je joue aux devinettes en trouvant répondant à une question magique ? :roll:

Je vois pas ou est le problème.

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
 
 
Option Explicit
 
Public Sub fusion_Click()
 
' les variables
 
' variables pour les feuilles de classeurs et les classeurs
 
Dim onglet_fusionA As Worksheet
Dim onglet_fusionb As Worksheet
Dim fichier_fusionA As Workbook
Dim fichier_fusionB As Workbook
 
' variables pour les nb de ligne d'une feuille
 
Dim nblf1 As Integer
Dim nblf2 As Integer
Dim nblf3 As Integer
Dim nblf4 As Integer
Dim nblf5 As Integer
Dim nblf6 As Integer
Dim nblf7 As Integer
Dim nblf8 As Integer
Dim nblf9 As Integer
Dim nblf10 As Integer
 
Dim nblent1 As Integer
Dim nblent2 As Integer
Dim nblent3 As Integer
Dim nblent4 As Integer
Dim nblent5 As Integer
Dim nblent6 As Integer
Dim nblent7 As Integer
Dim nblent8 As Integer
Dim nblent9 As Integer
Dim nblent10 As Integer
 
' variables pour les nb de ligne total
 
Dim nbltot1 As Integer
Dim nbltot2 As Integer
Dim nbltot3 As Integer
Dim nbltot4 As Integer
Dim nbltot5 As Integer
Dim nbltot6 As Integer
Dim nbltot7 As Integer
Dim nbltot8 As Integer
Dim nbltot9 As Integer
Dim nbltot10 As Integer
 
' variables pour les nb de colonne d'une feuille
 
Dim nbcf1 As Integer
Dim nbcf2 As Integer
Dim nbcf3 As Integer
Dim nbcf4 As Integer
Dim nbcf5 As Integer
Dim nbcf6 As Integer
Dim nbcf7 As Integer
Dim nbcf8 As Integer
Dim nbcf9 As Integer
Dim nbcf10 As Integer
 
Dim nbcent1 As Integer
Dim nbcent2 As Integer
Dim nbcent3 As Integer
Dim nbcent4 As Integer
Dim nbcent5 As Integer
Dim nbcent6 As Integer
Dim nbcent7 As Integer
Dim nbcent8 As Integer
Dim nbcent9 As Integer
Dim nbcent10 As Integer
 
' variables pour les nb de colonne total
 
Dim nbctot1 As Integer
Dim nbctot2 As Integer
Dim nbctot3 As Integer
Dim nbctot4 As Integer
Dim nbctot5 As Integer
Dim nbctot6 As Integer
Dim nbctot7 As Integer
Dim nbctot8 As Integer
Dim nbctot9 As Integer
Dim nbctot10 As Integer
 
' declaration de variable compteur
 
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
 
Dim cpt1 As Integer
Dim cpt2 As Integer
 
Dim nblp1 As Integer
Dim nblp2 As Integer
Dim nblp3 As Integer
Dim nblp4 As Integer
Dim nblp5 As Integer
Dim nblp6 As Integer
Dim nblp7 As Integer
Dim nblp8 As Integer
Dim nblp9 As Integer
Dim nblp10 As Integer
 
' variable pour l utilisation des chaines de caractères
 
Dim chaine1 As String
Dim chaine2 As String
Dim chaine3 As String
Dim chaine4 As String
Dim chaine5 As String
Dim chaine6 As String
Dim chaine7 As String
Dim chaine8 As String
Dim chaine9 As String
Dim chaine10 As String
 
' variable pour les classeurs
 
Dim wbk1 As Workbook
Dim wbk2 As Workbook
Dim wbk3 As Workbook
Dim wbk4 As Workbook
Dim wbk5 As Workbook
Dim wbk6 As Workbook
Dim wbk7 As Workbook
Dim wbk8 As Workbook
Dim wbk9 As Workbook
Dim wbk10 As Workbook
 
Dim wbkf1 As Workbook
Dim wbkf2 As Workbook
 
' variable pour des objets
 
Dim xlsApp1 As Object
Dim xlsApp2 As Object
 
' creation de tableaux à taille dynamique pour le deplacement des morceaux de tableau par bloc
 
Dim tabdyna1()
Dim tabdyna2()
Dim tabdyna3()
Dim tabdyna4()
 
' calcul du nombre de lignes et colonnes du fichier d'entete (onglet A) , ici on est directement dans le fichier avec les lignes d'entetes ou il y a la macro dans le même fichier .
 
' il est inutile d ouvrir le fichier puisque on est déjà dedans ? Pourtant le compilateur VBa dit que le fichier n est pas ouvert !!! illogique ...
 
ActiveWorkbook.Worksheets("ongleta").Activate
'wb.Worksheets("Gestion_Boite").Activate
     nblent1 = ActiveSheet.UsedRange.Rows.Count
     nbcent1 = ActiveSheet.UsedRange.Columns.Count
 
' rangement dans le tableau a taille variable , on ne sait pas combien de lignes seront empilées ...
 
tabdyna1(1, nbcent1 - 8) = Range("A" & 1)
tabdyna1(1, nbcent1 - 7) = Range("B" & 1)
tabdyna1(1, nbcent1 - 6) = Range("C" & 1)
tabdyna1(1, nbcent1 - 5) = Range("D" & 1)
tabdyna1(1, nbcent1 - 4) = Range("E" & 1)
tabdyna1(1, nbcent1 - 3) = Range("F" & 1)
tabdyna1(1, nbcent1 - 2) = Range("G" & 1)
tabdyna1(1, nbcent1 - 1) = Range("H" & 1)
tabdyna1(1, nbcent1) = Range("I" & 1)
 
cpt1 = nblent1
 
' calcul du nombre de lignes et colonnes du fichier d'entete (onglet B)
ActiveWorkbook.Worksheets("ongletb").Activate
 
'ActiveWorkbook.Sheets ("ongletb")
    nblent2 = ActiveSheet.UsedRange.Rows.Count
    nbcent2 = ActiveSheet.UsedRange.Columns.Count
 
' rangement dans le tableau a taille variable , on ne sait pas combien de lignes seront empilées ..
 
tabdyna2(1, nbcent2 - 5) = Range("A" & 1)
tabdyna2(1, nbcent2 - 4) = Range("B" & 1)
tabdyna2(1, nbcent2 - 3) = Range("C" & 1)
tabdyna2(1, nbcent2 - 2) = Range("D" & 1)
tabdyna2(1, nbcent2 - 1) = Range("E" & 1)
tabdyna2(1, nbcent2) = Range("F" & 1)
 
cpt2 = nblent2
 
' fichier de donnees
 
    ' fichier 1 -------------------------
 
    ' fichier 1 onglet A
 
    wbk1 = Workbooks.Open(Filename:="P:\fichier_donnees1.xlsx")
 
    wbk1.Worksheets("ongleta").Activate
    nblf1 = ActiveSheet.UsedRange.Rows.Count
    nbcf1 = ActiveSheet.UsedRange.Columns.Count
 
    For i = (cpt1 + 1) To nblf1 ' toujour un remplissage à la ligne ligne+1
 
    tabdyna1(nblf1, nbcf1 - 8) = Range("A" & nblf1)
    tabdyna1(nblf1, nbcf1 - 7) = Range("B" & nblf1)
    tabdyna1(nblf1, nbcf1 - 6) = Range("C" & nblf1)
    tabdyna1(nblf1, nbcf1 - 5) = Range("D" & nblf1)
    tabdyna1(nblf1, nbcf1 - 4) = Range("E" & nblf1)
    tabdyna1(nblf1, nbcf1 - 3) = Range("F" & nblf1)
    tabdyna1(nblf1, nbcf1 - 2) = Range("G" & nblf1)
    tabdyna1(nblf1, nbcf1 - 1) = Range("H" & nblf1)
    tabdyna1(nblf1, nbcf1) = Range("I" & nblf1)
 
    Next
 
    cpt1 = cpt1 + nblf1
 
    ' fichier 1 onglet B
 
    wbk2 = Workbooks.Open(Filename:="P:\fichier_donnees1.xlsx")
 
    wbk2.Worksheets("ongletb").Activate
    nblf2 = ActiveSheet.UsedRange.Rows.Count
    nbcf2 = ActiveSheet.UsedRange.Columns.Count
 
    For i = (cpt2 + 1) To nblf2 ' toujour un remplissage à la ligne ligne+1
 
    tabdyna1(nblf2, nbcf2 - 5) = Range("A" & nblf2)
    tabdyna1(nblf2, nbcf2 - 4) = Range("B" & nblf2)
    tabdyna1(nblf2, nbcf2 - 3) = Range("C" & nblf2)
    tabdyna1(nblf2, nbcf2 - 2) = Range("D" & nblf2)
    tabdyna1(nblf2, nbcf2 - 1) = Range("E" & nblf2)
    tabdyna1(nblf2, nbcf2) = Range("F" & nblf2)
 
    Next
 
    cpt2 = cpt2 + nblf2
 
    ' fin traitement fichier donnees 1
 
    'fichier 2
 
' fichier 2 onglet A
 
wbk2 = Workbooks.Open(Filename:="P:\fichier_donnees2.xlsx")
 
 
 
wbk2.Worksheets("ongleta").Activate
nblf3 = ActiveSheet.UsedRange.Rows.Count
nbcf1 = ActiveSheet.UsedRange.Columns.Count
 
For i = (cpt1 + 1) To nblf3 ' toujour un remplissage à la ligne ligne+1
 
tabdyna1(nblf3, nbcf1 - 8) = Range("A" & nblf3)
tabdyna1(nblf3, nbcf1 - 7) = Range("B" & nblf3)
tabdyna1(nblf3, nbcf1 - 6) = Range("C" & nblf3)
tabdyna1(nblf3, nbcf1 - 5) = Range("D" & nblf3)
tabdyna1(nblf3, nbcf1 - 4) = Range("E" & nblf3)
tabdyna1(nblf3, nbcf1 - 3) = Range("F" & nblf3)
tabdyna1(nblf3, nbcf1 - 2) = Range("G" & nblf3)
tabdyna1(nblf3, nbcf1 - 1) = Range("H" & nblf3)
tabdyna1(nblf3, nbcf1) = Range("I" & nblf3)
 
Next
 
cpt1 = cpt1 + nblf3
 
' fichier 2 onglet B
 
wbk4 = Workbooks.Open(Filename:="P:\fichier_donnees2.xlsx")
 
wbk4.Worksheets("ongletb").Activate
nblf4 = ActiveSheet.UsedRange.Rows.Count
nbcf2 = ActiveSheet.UsedRange.Columns.Count
 
For i = (cpt2 + 1) To nblf4 ' toujour un remplissage à la ligne ligne+1
 
tabdyna2(nblf4, nbcf2 - 5) = Range("A" & nblf4)
tabdyna2(nblf4, nbcf2 - 4) = Range("B" & nblf4)
tabdyna2(nblf4, nbcf2 - 3) = Range("C" & nblf4)
tabdyna2(nblf4, nbcf2 - 2) = Range("D" & nblf4)
tabdyna2(nblf4, nbcf2 - 1) = Range("E" & nblf4)
tabdyna2(nblf4, nbcf2) = Range("F" & nblf4)
 
Next
 
cpt2 = cpt2 + nblf4
 
'fin traitement fichier donnees 2
 
'fichier 3
 
' fichier 3 onglet A
 
wbk3 = Workbooks.Open(Filename:="P:\fichier_donnees3.xls")
 
 
 
wbk3.Worksheets("ongleta").Activate
nblf5 = ActiveSheet.UsedRange.Rows.Count
nbcf1 = ActiveSheet.UsedRange.Columns.Count
 
For i = (cpt1 + 1) To nblf5 ' toujour un remplissage à la ligne ligne+1
 
tabdyna1(nblf5, nbcf1 - 8) = Range("A" & nblf5)
tabdyna1(nblf5, nbcf1 - 7) = Range("B" & nblf5)
tabdyna1(nblf5, nbcf1 - 6) = Range("C" & nblf5)
tabdyna1(nblf5, nbcf1 - 5) = Range("D" & nblf5)
tabdyna1(nblf5, nbcf1 - 4) = Range("E" & nblf5)
tabdyna1(nblf5, nbcf1 - 3) = Range("F" & nblf5)
tabdyna1(nblf5, nbcf1 - 2) = Range("G" & nblf5)
tabdyna1(nblf5, nbcf1 - 1) = Range("H" & nblf5)
tabdyna1(nblf5, nbcf1) = Range("I" & nblf5)
 
Next
 
cpt1 = cpt1 + nblf5
 
' fichier 3 onglet B
 
wbk6 = Workbooks.Open(Filename:="P:\fichier_donnees3.xls")
 
wbk6.Worksheets("ongletb").Activate
nblf6 = ActiveSheet.UsedRange.Rows.Count
nbcf2 = ActiveSheet.UsedRange.Columns.Count
 
For i = (cpt2 + 1) To nblf6 ' toujour un remplissage à la ligne ligne+1
 
tabdyna2(nblf6, nbcf2 - 5) = Range("A" & nblf6)
tabdyna2(nblf6, nbcf2 - 4) = Range("B" & nblf6)
tabdyna2(nblf6, nbcf2 - 3) = Range("C" & nblf6)
tabdyna2(nblf6, nbcf2 - 2) = Range("D" & nblf6)
tabdyna2(nblf6, nbcf2 - 1) = Range("E" & nblf6)
tabdyna2(nblf6, nbcf2) = Range("F" & nblf6)
 
Next
 
cpt2 = cpt2 + nblf6
 
'fin traitement fichier donnees 3
 
'fin d'import des données dans les feuilles excel dans les tableaux virtuels dynamiques
 
' nommination des futures feuilles et classeurs excel
 
chaine1 = "P:\fusion_ongleta.xlsx"
chaine2 = "P:\fusion_ongletb.xlsx"
chaine3 = "ongleta"
chaine4 = "ongletb"
 
' creation des fichiers de sorties
 
'xlApp1 = CreateObject("Excel.Application", chaine1)
'xlApp2 = CreateObject("Excel.Application", chaine2)
 
' ouverture des fichiers excel nouvellement créés
 
wbkf1 = Workbooks.Open(Filename:=chaine1)
'xlSheet1 = xlApp1.Createworksheets(chaine3)
wbkf1.Worksheets("ongleta").Activate
 
wbkf2 = Workbooks.Open(Filename:=chaine2)
'xlSheet2 = xlApp2.Createworksheets(chaine4)
wbkf2.Worksheets("ongletb").Activate
 
' compacter les lignes dans les feuilles créés
 
' onglet de fusion A >> injection des données
 
 For i = 1 To cpt1  ' ligne par ligne
 
        Worksheets(chaine3).Add(xlSrcRange, Range("A" & i), xlYes) = tabdyna1(i, nbcf1 - 8)
        Worksheets(chaine3).Add(xlSrcRange, Range("B" & i), xlYes) = tabdyna1(i, nbcf1 - 7)
        Worksheets(chaine3).Add(xlSrcRange, Range("C" & i), xlYes) = tabdyna1(i, nbcf1 - 6)
        Worksheets(chaine3).Add(xlSrcRange, Range("D" & i), xlYes) = tabdyna1(i, nbcf1 - 5)
        Worksheets(chaine3).Add(xlSrcRange, Range("E" & i), xlYes) = tabdyna1(i, nbcf1 - 4)
        Worksheets(chaine3).Add(xlSrcRange, Range("F" & i), xlYes) = tabdyna1(i, nbcf1 - 3)
        Worksheets(chaine3).Add(xlSrcRange, Range("G" & i), xlYes) = tabdyna1(i, nbcf1 - 2)
        Worksheets(chaine3).Add(xlSrcRange, Range("H" & i), xlYes) = tabdyna1(i, nbcf1 - 1)
        Worksheets(chaine3).Add(xlSrcRange, Range("I" & i), xlYes) = tabdyna1(i, nbcf1)
 
Next
 
' onglet de fusion B >> injection des données
 
 For i = 1 To cpt2  ' ligne par ligne
 
        Worksheets(chaine4).Add(xlSrcRange, Range("A" & i), xlYes) = tabdyna1(i, nbcf2 - 5)
        Worksheets(chaine4).Add(xlSrcRange, Range("B" & i), xlYes) = tabdyna1(i, nbcf2 - 4)
        Worksheets(chaine4).Add(xlSrcRange, Range("C" & i), xlYes) = tabdyna1(i, nbcf2 - 3)
        Worksheets(chaine4).Add(xlSrcRange, Range("D" & i), xlYes) = tabdyna1(i, nbcf2 - 2)
        Worksheets(chaine4).Add(xlSrcRange, Range("E" & i), xlYes) = tabdyna1(i, nbcf2 - 1)
        Worksheets(chaine4).Add(xlSrcRange, Range("F" & i), xlYes) = tabdyna1(i, nbcf2)
 
Next
 
End Sub

Merci de l'aiguillage ;)

30/10/2015, 15h18
Theze
Bonjour,

En pas à pas avec F8 le débogueur s'arrête sur quelle ligne, celle là ?
Code:

1 2 NomFeuille = "onglet_A"
Oups, pardon, celle là plutôt ?
Code:

1 2 Set Plage = Cls.Worksheets(NomFeuille).Range("A1").CurrentRegion

Bonjour ,

J'ai débogué avec F8.

J'arrive à : 1 > ouvrir les documents excels
2 > créer les documents excel nécessaires
3 > copier les données des feuilles dans un tableau temporaire.
4 > c'est ici que cela bloque , je ne sais pas déverser les données du tableau temporaire dans les nouvelles feuilles Excel. :? , c'est la ligne 295 du code

Voici le code retravaillé et l'endroit ou cela plante :

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
Option Explicit
 
Public Sub fusion_Click()
 
' les variables
 
' variables pour les feuilles de classeurs et les classeurs
 
Dim onglet_fusionA As Worksheet
Dim onglet_fusionb As Worksheet
Dim fichier_fusionA As Workbook
Dim fichier_fusionB As Workbook
 
' variables pour les nb de ligne d'une feuille
 
Dim nblf1 As Integer
Dim nblf2 As Integer
Dim nblf3 As Integer
Dim nblf4 As Integer
Dim nblf5 As Integer
Dim nblf6 As Integer
Dim nblf7 As Integer
Dim nblf8 As Integer
Dim nblf9 As Integer
Dim nblf10 As Integer
 
Dim nblent1 As Integer
Dim nblent2 As Integer
Dim nblent3 As Integer
Dim nblent4 As Integer
Dim nblent5 As Integer
Dim nblent6 As Integer
Dim nblent7 As Integer
Dim nblent8 As Integer
Dim nblent9 As Integer
Dim nblent10 As Integer
 
' variables pour les nb de ligne total
 
Dim nbltot1 As Integer
Dim nbltot2 As Integer
Dim nbltot3 As Integer
Dim nbltot4 As Integer
Dim nbltot5 As Integer
Dim nbltot6 As Integer
Dim nbltot7 As Integer
Dim nbltot8 As Integer
Dim nbltot9 As Integer
Dim nbltot10 As Integer
 
' variables pour les nb de colonne d'une feuille
 
Dim nbcf1 As Integer
Dim nbcf2 As Integer
Dim nbcf3 As Integer
Dim nbcf4 As Integer
Dim nbcf5 As Integer
Dim nbcf6 As Integer
Dim nbcf7 As Integer
Dim nbcf8 As Integer
Dim nbcf9 As Integer
Dim nbcf10 As Integer
 
Dim nbcent1 As Integer
Dim nbcent2 As Integer
Dim nbcent3 As Integer
Dim nbcent4 As Integer
Dim nbcent5 As Integer
Dim nbcent6 As Integer
Dim nbcent7 As Integer
Dim nbcent8 As Integer
Dim nbcent9 As Integer
Dim nbcent10 As Integer
 
' variables pour les nb de colonne total
 
Dim nbctot1 As Integer
Dim nbctot2 As Integer
Dim nbctot3 As Integer
Dim nbctot4 As Integer
Dim nbctot5 As Integer
Dim nbctot6 As Integer
Dim nbctot7 As Integer
Dim nbctot8 As Integer
Dim nbctot9 As Integer
Dim nbctot10 As Integer
 
' declaration de variable compteur
 
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
 
Dim cpt1 As Integer
Dim cpt2 As Integer
 
Dim nblp1 As Integer
Dim nblp2 As Integer
Dim nblp3 As Integer
Dim nblp4 As Integer
Dim nblp5 As Integer
Dim nblp6 As Integer
Dim nblp7 As Integer
Dim nblp8 As Integer
Dim nblp9 As Integer
Dim nblp10 As Integer
 
' variable pour l utilisation des chaines de caractères
 
Dim chaine1 As String
Dim chaine2 As String
Dim chaine3 As String
Dim chaine4 As String
Dim chaine5 As String
Dim chaine6 As String
Dim chaine7 As String
Dim chaine8 As String
Dim chaine9 As String
Dim chaine10 As String
 
' variable pour les classeurs
 
Dim wbk1 As Workbook
Dim wbk2 As Workbook
Dim wbk3 As Workbook
Dim wbk4 As Workbook
Dim wbk5 As Workbook
Dim wbk6 As Workbook
Dim wbk7 As Workbook
Dim wbk8 As Workbook
Dim wbk9 As Workbook
Dim wbk10 As Workbook
 
Dim wbkf1 As Workbook
Dim wbkf2 As Workbook
 
' variable pour des objets
 
Dim xlsApp1 As Object
Dim xlsApp2 As Object
 
' creation de tableaux à taille dynamique pour le deplacement des morceaux de tableau par bloc
 
Dim tabdyna1()
Dim tabdyna2()
Dim tabdyna3()
Dim tabdyna4()
 
' calcul du nombre de lignes et colonnes du fichier d'entete (onglet A) , ici on est directement dans le fichier avec les lignes d'entetes ou il y a la macro dans le même fichier .
 
 
ActiveWorkbook.Worksheets("ongleta").Activate
'wb.Worksheets("Gestion_Boite").Activate
     nblent1 = ActiveSheet.UsedRange.Rows.Count
     nbcent1 = ActiveSheet.UsedRange.Columns.Count
 
' rangement dans le tableau a taille variable , on ne sait pas combien de lignes seront empilées ...
 
ReDim tabdyna1(1, 0)
tabdyna1(1, 0) = Range("A" & 1)
ReDim tabdyna1(1, 1)
tabdyna1(1, 1) = Range("B" & 1)
ReDim tabdyna1(1, 2)
tabdyna1(1, 2) = Range("C" & 1)
ReDim tabdyna1(1, 3)
tabdyna1(1, 3) = Range("D" & 1)
ReDim tabdyna1(1, 4)
tabdyna1(1, 4) = Range("E" & 1)
ReDim tabdyna1(1, 5)
tabdyna1(1, 5) = Range("F" & 1)
ReDim tabdyna1(1, 6)
tabdyna1(1, 6) = Range("G" & 1)
ReDim tabdyna1(1, 7)
tabdyna1(1, 7) = Range("H" & 1)
ReDim tabdyna1(1, 8)
tabdyna1(1, 8) = Range("I" & 1)
cpt1 = nblent1
 
' calcul du nombre de lignes et colonnes du fichier d'entete (onglet B)
ActiveWorkbook.Worksheets("ongletb").Activate
 
'ActiveWorkbook.Sheets ("ongletb")
    nblent2 = ActiveSheet.UsedRange.Rows.Count
    nbcent2 = ActiveSheet.UsedRange.Columns.Count
 
' rangement dans le tableau a taille variable , on ne sait pas combien de lignes seront empilées ..
 
ReDim tabdyna2(1, 0)
tabdyna2(1, 0) = Range("A" & 1)
ReDim tabdyna2(1, 1)
tabdyna2(1, 1) = Range("B" & 1)
ReDim tabdyna2(1, 2)
tabdyna2(1, 2) = Range("C" & 1)
ReDim tabdyna2(1, 3)
tabdyna2(1, 3) = Range("D" & 1)
ReDim tabdyna2(1, 4)
tabdyna2(1, 4) = Range("E" & 1)
ReDim tabdyna2(1, 5)
tabdyna2(1, 5) = Range("F" & 1)
 
cpt2 = nblent2
 
' fichier de donnees
 
'fichier 1
 
' fichier 1 onglet A
 
Set wbk1 = Workbooks.Open(Filename:="P:\fichier_donnees1.xlsx")
 
Set wbk1 = ThisWorkbook
ThisWorkbook.Activate
 
wbk1.Worksheets("ongleta").Activate
'Workbooks.Open(Filename:="P:\fichier_donnees1.xlsx").Worksheets("ongleta").Activate
nblf1 = ActiveSheet.UsedRange.Rows.Count
nbcf1 = ActiveSheet.UsedRange.Columns.Count
 
For i = (cpt1 + 1) To nblf1 ' toujour un remplissage à la ligne ligne+1
 
ReDim tabdyna1(nblf1, nbcf1 - 8)
tabdyna1(nblf1, nbcf1 - 8) = Range("A" & nblf1)
ReDim tabdyna1(nblf1, nbcf1 - 7)
tabdyna1(nblf1, nbcf1 - 7) = Range("B" & nblf1)
ReDim tabdyna1(nblf1, nbcf1 - 6)
tabdyna1(nblf1, nbcf1 - 6) = Range("C" & nblf1)
ReDim tabdyna1(nblf1, nbcf1 - 5)
tabdyna1(nblf1, nbcf1 - 5) = Range("D" & nblf1)
ReDim tabdyna1(nblf1, nbcf1 - 4)
tabdyna1(nblf1, nbcf1 - 4) = Range("E" & nblf1)
ReDim tabdyna1(nblf1, nbcf1 - 3)
tabdyna1(nblf1, nbcf1 - 3) = Range("F" & nblf1)
ReDim tabdyna1(nblf1, nbcf1 - 2)
tabdyna1(nblf1, nbcf1 - 2) = Range("G" & nblf1)
ReDim tabdyna1(nblf1, nbcf1 - 1)
tabdyna1(nblf1, nbcf1 - 1) = Range("H" & nblf1)
ReDim tabdyna1(nblf1, nbcf1)
tabdyna1(nblf1, nbcf1) = Range("I" & nblf1)
 
Next
 
cpt1 = cpt1 + nblf1
 
' fichier 1 onglet B
 
Set wbk2 = Workbooks.Open(Filename:="P:\fichier_donnees1.xlsx")
 
Set wbk2 = ThisWorkbook
ThisWorkbook.Activate
 
wbk2.Worksheets("ongletb").Activate
 
nblf2 = ActiveSheet.UsedRange.Rows.Count
nbcf2 = ActiveSheet.UsedRange.Columns.Count
 
For i = (cpt2 + 1) To nblf2 ' toujour un remplissage à la ligne ligne+1
 
ReDim tabdyna2(nblf2, nbcf2 - 5)
tabdyna2(nblf2, nbcf2 - 5) = Range("A" & nblf2)
ReDim tabdyna2(nblf2, nbcf2 - 4)
tabdyna2(nblf2, nbcf2 - 4) = Range("B" & nblf2)
ReDim tabdyna2(nblf2, nbcf2 - 3)
tabdyna2(nblf2, nbcf2 - 3) = Range("C" & nblf2)
ReDim tabdyna2(nblf2, nbcf2 - 2)
tabdyna2(nblf2, nbcf2 - 2) = Range("D" & nblf2)
ReDim tabdyna2(nblf2, nbcf2 - 1)
tabdyna2(nblf2, nbcf2 - 1) = Range("E" & nblf2)
ReDim tabdyna2(nblf2, nbcf2)
tabdyna2(nblf2, nbcf2) = Range("F" & nblf2)
 
Next
 
cpt2 = cpt2 + nblf2
 
'fin traitement fichier donnees 1
 
 
'fin d'import des données dans les feuilles excel dans les tableaux virtuels dynamiques
 
' nommination des futures feuilles et classeurs excel
 
chaine1 = "P:\fusion_ongleta.xlsx"
chaine2 = "P:\fusion_ongletb.xlsx"
chaine3 = "ongleta"
chaine4 = "ongletb"
 
' creation des fichiers de sorties
 
'xlApp1 = CreateObject("Excel.Application", chaine1)
'xlApp2 = CreateObject("Excel.Application", chaine2)
 
' ouverture des fichiers excel nouvellement créés
 
' >>>>>>>>>>>>>>>>>>>>>>> c'est  à parti d'ici que le programme plante il se sait pas ouvrir les nouveaux fichiers pour y déposer les données des tableaux temporaires VBA. <<<<<<<<<<<<<<<<<<<<<<<<<<<
 
 
Set wbkf1 = Workbooks.Open(Filename:=chaine1)
'xlSheet1 = xlApp1.Createworksheets(chaine3)
Set wbkf1 = ThisWorkbook
'wbkf1.Worksheets("ongleta").Activate
wbk1.Worksheets("ongleta").Activate
 
Set wbkf2 = Workbooks.Open(Filename:=chaine2)
'xlSheet2 = xlApp2.Createworksheets(chaine4)
Set wbkf2 = ThisWorkbook
'wbkf2.Worksheets("ongletb").Activate
wbk2.Worksheets("ongletb").Activate
 
' compacter les lignes dans les feuilles créés
 
' onglet de fusion A >> injection des données
 
 For i = 1 To cpt1  ' ligne par ligne
 
        Worksheets(chaine3).Add(xlSrcRange, Range("A" & i)) = tabdyna1(i, nbcf1 - 8)
        Worksheets(chaine3).Add(xlSrcRange, Range("B" & i)) = tabdyna1(i, nbcf1 - 7)
        Worksheets(chaine3).Add(xlSrcRange, Range("C" & i)) = tabdyna1(i, nbcf1 - 6)
        Worksheets(chaine3).Add(xlSrcRange, Range("D" & i)) = tabdyna1(i, nbcf1 - 5)
        Worksheets(chaine3).Add(xlSrcRange, Range("E" & i)) = tabdyna1(i, nbcf1 - 4)
        Worksheets(chaine3).Add(xlSrcRange, Range("F" & i)) = tabdyna1(i, nbcf1 - 3)
        Worksheets(chaine3).Add(xlSrcRange, Range("G" & i)) = tabdyna1(i, nbcf1 - 2)
        Worksheets(chaine3).Add(xlSrcRange, Range("H" & i)) = tabdyna1(i, nbcf1 - 1)
        Worksheets(chaine3).Add(xlSrcRange, Range("I" & i)) = tabdyna1(i, nbcf1)
 
Next
 
' onglet de fusion B >> injection des données
 
 For i = 1 To cpt2  ' ligne par ligne
 
        Worksheets(chaine4).Add(xlSrcRange, Range("A" & i), xlYes) = tabdyna1(i, nbcf2 - 5)
        Worksheets(chaine4).Add(xlSrcRange, Range("B" & i), xlYes) = tabdyna1(i, nbcf2 - 4)
        Worksheets(chaine4).Add(xlSrcRange, Range("C" & i), xlYes) = tabdyna1(i, nbcf2 - 3)
        Worksheets(chaine4).Add(xlSrcRange, Range("D" & i), xlYes) = tabdyna1(i, nbcf2 - 2)
        Worksheets(chaine4).Add(xlSrcRange, Range("E" & i), xlYes) = tabdyna1(i, nbcf2 - 1)
        Worksheets(chaine4).Add(xlSrcRange, Range("F" & i), xlYes) = tabdyna1(i, nbcf2)
 
Next
 
End Sub

Merci pour l'aiguillage ;)

03/11/2015, 13h18
Marc-L

Bonjour.

Citation:

Envoyé par tanaka59

Le fichier d'entêtes à la même structure sauf qu'il n'a que les entêtes.

Le but est de fusionner les traitements de type A d'en 1 fichier A et de type B dans un fichier B.

Environ une vingtaine de lignes de code via l'utilisation de filtres avancés !

______________________________________________________________________________________________________
Je suis Charlie, Bardo, Sousse
03/11/2015, 15h09
Invité

1 pièce(s) jointe(s)

Attention ici au final il ne faut que deux fichiers avec un onglet chacun !

Vous vous me proposez de faire plusieurs onglets dans un fichier . Non ici je suis un un empilement de tableaux issus de plusieurs classeurs et feuilles de calculs !

Je ré explique.

Au lieu des faire des dizaines de copier / coller , le but est que grâce à mon code le VBA le face pour moi :

Comme illustré ici dans mon exemple :

Pièce jointe 191732
03/11/2015, 15h17
Invité

Bonjour,
je réitère ma proposition, bien que vraisemblablement elle ne t'intéresse pas: http://www.developpez.net/forums/d15...e/#post8404415

Bonjour,

1) J'ai testé ce code proposé comme préconisé : http://www.developpez.net/forums/d15...ichiers-excel/. Le code VBA ne fonctionne pas :/

J'ai beau ajuster les liens du code proposé , rien ne se passe .

2) Autre problème

J'ai 'erreur VBA 438 , microsoft donne bien entendu une solution fausse : https://support.microsoft.com/fr-fr/...r-fr/kb/175616 ...

Code:

1
2
3
4
5
6
7
8
9
Private Sub Command1_Click()
         Dim MyForm As Form
         Dim i As Long
         Set MyForm = Form1
         For i = 1 To 10000
            MyForm.Command1.Caption = i
            DoEvents
         Next i
       End Sub

J'ai repris ce que microsoft préconise + ce que vous donnez comme 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
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
Option Explicit
 
Public Sub fusion_Click()
 
' les variables
 
' variables pour les feuilles de classeurs et les classeurs
 
Dim onglet_fusionA As Worksheet
Dim onglet_fusionb As Worksheet
Dim fichier_fusionA As Workbook
Dim fichier_fusionB As Workbook
 
' variables pour les nb de ligne d'une feuille
 
Dim nblf1 As Integer
Dim nblf2 As Integer
Dim nblf3 As Integer
Dim nblf4 As Integer
Dim nblf5 As Integer
Dim nblf6 As Integer
Dim nblf7 As Integer
Dim nblf8 As Integer
Dim nblf9 As Integer
Dim nblf10 As Integer
 
Dim nblent1 As Integer
Dim nblent2 As Integer
Dim nblent3 As Integer
Dim nblent4 As Integer
Dim nblent5 As Integer
Dim nblent6 As Integer
Dim nblent7 As Integer
Dim nblent8 As Integer
Dim nblent9 As Integer
Dim nblent10 As Integer
 
' variables pour les nb de ligne total
 
Dim nbltot1 As Integer
Dim nbltot2 As Integer
Dim nbltot3 As Integer
Dim nbltot4 As Integer
Dim nbltot5 As Integer
Dim nbltot6 As Integer
Dim nbltot7 As Integer
Dim nbltot8 As Integer
Dim nbltot9 As Integer
Dim nbltot10 As Integer
 
' variables pour les nb de colonne d'une feuille
 
Dim nbcf1 As Integer
Dim nbcf2 As Integer
Dim nbcf3 As Integer
Dim nbcf4 As Integer
Dim nbcf5 As Integer
Dim nbcf6 As Integer
Dim nbcf7 As Integer
Dim nbcf8 As Integer
Dim nbcf9 As Integer
Dim nbcf10 As Integer
 
Dim nbcent1 As Integer
Dim nbcent2 As Integer
Dim nbcent3 As Integer
Dim nbcent4 As Integer
Dim nbcent5 As Integer
Dim nbcent6 As Integer
Dim nbcent7 As Integer
Dim nbcent8 As Integer
Dim nbcent9 As Integer
Dim nbcent10 As Integer
 
' variables pour les nb de colonne total
 
Dim nbctot1 As Integer
Dim nbctot2 As Integer
Dim nbctot3 As Integer
Dim nbctot4 As Integer
Dim nbctot5 As Integer
Dim nbctot6 As Integer
Dim nbctot7 As Integer
Dim nbctot8 As Integer
Dim nbctot9 As Integer
Dim nbctot10 As Integer
 
' declaration de variable compteur
 
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
 
Dim cpt1 As Integer
Dim cpt2 As Integer
 
Dim nblp1 As Integer
Dim nblp2 As Integer
Dim nblp3 As Integer
Dim nblp4 As Integer
Dim nblp5 As Integer
Dim nblp6 As Integer
Dim nblp7 As Integer
Dim nblp8 As Integer
Dim nblp9 As Integer
Dim nblp10 As Integer
 
' variable pour l utilisation des chaines de caractères
 
Dim chaine1 As String
Dim chaine2 As String
Dim chaine3 As String
Dim chaine4 As String
Dim chaine5 As String
Dim chaine6 As String
Dim chaine7 As String
Dim chaine8 As String
Dim chaine9 As String
Dim chaine10 As String
 
' variable pour les classeurs
 
Dim wbk1 As Workbook
Dim wbk2 As Workbook
Dim wbk3 As Workbook
Dim wbk4 As Workbook
Dim wbk5 As Workbook
Dim wbk6 As Workbook
Dim wbk7 As Workbook
Dim wbk8 As Workbook
Dim wbk9 As Workbook
Dim wbk10 As Workbook
 
Dim wbkf1 As Workbook
Dim wbkf2 As Workbook
 
' variable pour des objets
 
Dim xlsApp1 As Object
Dim xlsApp2 As Object
 
' creation de tableaux à taille dynamique pour le deplacement des morceaux de tableau par bloc
 
Dim tabdyna1()
Dim tabdyna2()
Dim tabdyna3()
Dim tabdyna4()
 
' creation des formulaires
 
' traitement feuille de classeur
 
Dim MyForm1 As Form
Dim MyForm2 As Form
Dim MyForm3 As Form
Dim MyForm4 As Form
Dim MyForm5 As Form
Dim MyForm6 As Form
Dim MyForm7 As Form
Dim MyForm8 As Form
Dim MyForm9 As Form
Dim MyForm10 As Form
 
' fusion finale
 
Dim MyForm1f As Form
Dim MyForm2f As Form
Dim MyForm3f As Form
Dim MyForm4f As Form
Dim MyForm5f As Form
Dim MyForm6f As Form
Dim MyForm7f As Form
Dim MyForm8f As Form
Dim MyForm9f As Form
Dim MyForm10f As Form
 
' calcul du nombre de lignes et colonnes du fichier d'entete (onglet A) , ici on est directement dans le fichier avec les lignes d'entetes ou il y a la macro dans le même fichier .
 
ActiveWorkbook.Worksheets("ongleta").Activate
'wb.Worksheets("Gestion_Boite").Activate
     nblent1 = ActiveSheet.UsedRange.Rows.Count
     nbcent1 = ActiveSheet.UsedRange.Columns.Count
 
' rangement dans le tableau a taille variable , on ne sait pas combien de lignes seront empilées ...
 
ReDim tabdyna1(1, 0)
tabdyna1(1, 0) = Range("A" & 1)
ReDim tabdyna1(1, 1)
tabdyna1(1, 1) = Range("B" & 1)
ReDim tabdyna1(1, 2)
tabdyna1(1, 2) = Range("C" & 1)
ReDim tabdyna1(1, 3)
tabdyna1(1, 3) = Range("D" & 1)
ReDim tabdyna1(1, 4)
tabdyna1(1, 4) = Range("E" & 1)
ReDim tabdyna1(1, 5)
tabdyna1(1, 5) = Range("F" & 1)
ReDim tabdyna1(1, 6)
tabdyna1(1, 6) = Range("G" & 1)
ReDim tabdyna1(1, 7)
tabdyna1(1, 7) = Range("H" & 1)
ReDim tabdyna1(1, 8)
tabdyna1(1, 8) = Range("I" & 1)
cpt1 = nblent1
 
' calcul du nombre de lignes et colonnes du fichier d'entete (onglet B)
ActiveWorkbook.Worksheets("ongletb").Activate
 
'ActiveWorkbook.Sheets ("ongletb")
    nblent2 = ActiveSheet.UsedRange.Rows.Count
    nbcent2 = ActiveSheet.UsedRange.Columns.Count
 
' rangement dans le tableau a taille variable , on ne sait pas combien de lignes seront empilées ..
 
ReDim tabdyna2(1, 0)
tabdyna2(1, 0) = Range("A" & 1)
ReDim tabdyna2(1, 1)
tabdyna2(1, 1) = Range("B" & 1)
ReDim tabdyna2(1, 2)
tabdyna2(1, 2) = Range("C" & 1)
ReDim tabdyna2(1, 3)
tabdyna2(1, 3) = Range("D" & 1)
ReDim tabdyna2(1, 4)
tabdyna2(1, 4) = Range("E" & 1)
ReDim tabdyna2(1, 5)
tabdyna2(1, 5) = Range("F" & 1)
 
cpt2 = nblent2
 
' fichier de donnees
 
'fichier 1
 
' fichier 1 onglet A
 
wbk1 = Workbooks.Open(Filename:="P:\fichier_donnees1.xlsx")
 
 
 
wbk1.Worksheets("ongleta").Activate
nblf1 = ActiveSheet.UsedRange.Rows.Count
nbcf1 = ActiveSheet.UsedRange.Columns.Count
 
Set MyForm1 = Form1
 
For i = (cpt1 + 1) To nblf1 ' toujour un remplissage à la ligne ligne+1
 
MyForm.Command1.Caption = i
 
DoEvents
 
ReDim tabdyna1(nblf1, nbcf1 - 8)
tabdyna1(nblf1, nbcf1 - 8) = Range("A" & nblf1)
ReDim tabdyna1(nblf1, nbcf1 - 7)
tabdyna1(nblf1, nbcf1 - 7) = Range("B" & nblf1)
ReDim tabdyna1(nblf1, nbcf1 - 6)
tabdyna1(nblf1, nbcf1 - 6) = Range("C" & nblf1)
ReDim tabdyna1(nblf1, nbcf1 - 5)
tabdyna1(nblf1, nbcf1 - 5) = Range("D" & nblf1)
ReDim tabdyna1(nblf1, nbcf1 - 4)
tabdyna1(nblf1, nbcf1 - 4) = Range("E" & nblf1)
ReDim tabdyna1(nblf1, nbcf1 - 3)
tabdyna1(nblf1, nbcf1 - 3) = Range("F" & nblf1)
ReDim tabdyna1(nblf1, nbcf1 - 2)
tabdyna1(nblf1, nbcf1 - 2) = Range("G" & nblf1)
ReDim tabdyna1(nblf1, nbcf1 - 1)
tabdyna1(nblf1, nbcf1 - 1) = Range("H" & nblf1)
ReDim tabdyna1(nblf1, nbcf1)
tabdyna1(nblf1, nbcf1) = Range("I" & nblf1)
 
Next i
 
cpt1 = cpt1 + nblf1
 
' fichier 1 onglet B
 
wbk2 = Workbooks.Open(Filename:="P:\fichier_donnees1.xlsx")
 
wbk2.Worksheets("ongletb").Activate
nblf2 = ActiveSheet.UsedRange.Rows.Count
nbcf2 = ActiveSheet.UsedRange.Columns.Count
 
Set MyForm2 = Form2
 
For i = (cpt2 + 1) To nblf2 ' toujour un remplissage à la ligne ligne+1
 
MyForm.Command2.Caption = i2
 
DoEvents
 
ReDim tabdyna2(nblf2, nbcf2 - 5)
tabdyna2(nblf2, nbcf2 - 5) = Range("A" & nblf2)
ReDim tabdyna2(nblf2, nbcf2 - 4)
tabdyna2(nblf2, nbcf2 - 4) = Range("B" & nblf2)
ReDim tabdyna2(nblf2, nbcf2 - 3)
tabdyna2(nblf2, nbcf2 - 3) = Range("C" & nblf2)
ReDim tabdyna2(nblf2, nbcf2 - 2)
tabdyna2(nblf2, nbcf2 - 2) = Range("D" & nblf2)
ReDim tabdyna2(nblf2, nbcf2 - 1)
tabdyna2(nblf2, nbcf2 - 1) = Range("E" & nblf2)
ReDim tabdyna2(nblf2, nbcf2)
tabdyna2(nblf2, nbcf2) = Range("F" & nblf2)
 
Next i
 
cpt2 = cpt2 + nblf2
 
'fin traitement fichier donnees 1
 
'fin d'import des données dans les feuilles excel dans les tableaux virtuels dynamiques
 
' nommination des futures feuilles et classeurs excel
 
chaine1 = "P:\fusion_ongleta.xlsx"
chaine2 = "P:\fusion_ongletb.xlsx"
chaine3 = "ongleta"
chaine4 = "ongletb"
 
' creation des fichiers de sorties
 
'xlApp1 = CreateObject("Excel.Application", chaine1)
'xlApp2 = CreateObject("Excel.Application", chaine2)
 
' ouverture des fichiers excel nouvellement créés
 
Set wbkf1 = Workbooks.Open(Filename:=chaine1)
'xlSheet1 = xlApp1.Createworksheets(chaine3)
Set wbkf1 = ThisWorkbook
'wbkf1.Worksheets("ongleta").Activate
wbk1.Worksheets("ongleta").Activate
 
Set wbkf2 = Workbooks.Open(Filename:=chaine2)
'xlSheet2 = xlApp2.Createworksheets(chaine4)
Set wbkf2 = ThisWorkbook
'wbkf2.Worksheets("ongletb").Activate
wbk2.Worksheets("ongletb").Activate
 
 
' compacter les lignes dans les feuilles créés
 
' onglet de fusion A >> injection des données
 
Set MyForm1f = Form1f
 
 For i = 1 To cpt1  ' ligne par ligne
 
 MyForm.Command1f.Caption = i
 
 DoEvents
 
        Worksheets(chaine3).Add(xlSrcRange, Range("A" & i)) = tabdyna1(i, nbcf1 - 8)
        Worksheets(chaine3).Add(xlSrcRange, Range("B" & i)) = tabdyna1(i, nbcf1 - 7)
        Worksheets(chaine3).Add(xlSrcRange, Range("C" & i)) = tabdyna1(i, nbcf1 - 6)
        Worksheets(chaine3).Add(xlSrcRange, Range("D" & i)) = tabdyna1(i, nbcf1 - 5)
        Worksheets(chaine3).Add(xlSrcRange, Range("E" & i)) = tabdyna1(i, nbcf1 - 4)
        Worksheets(chaine3).Add(xlSrcRange, Range("F" & i)) = tabdyna1(i, nbcf1 - 3)
        Worksheets(chaine3).Add(xlSrcRange, Range("G" & i)) = tabdyna1(i, nbcf1 - 2)
        Worksheets(chaine3).Add(xlSrcRange, Range("H" & i)) = tabdyna1(i, nbcf1 - 1)
        Worksheets(chaine3).Add(xlSrcRange, Range("I" & i)) = tabdyna1(i, nbcf1)
 
Next i
 
' onglet de fusion B >> injection des données
 
Set MyForm2f = Form2f
 
 For i = 1 To cpt2  ' ligne par ligne
 
 MyForm.Command2f.Caption = i
 
 DoEvents
 
        Worksheets(chaine4).Add(xlSrcRange, Range("A" & i), xlYes) = tabdyna1(i, nbcf2 - 5)
        Worksheets(chaine4).Add(xlSrcRange, Range("B" & i), xlYes) = tabdyna1(i, nbcf2 - 4)
        Worksheets(chaine4).Add(xlSrcRange, Range("C" & i), xlYes) = tabdyna1(i, nbcf2 - 3)
        Worksheets(chaine4).Add(xlSrcRange, Range("D" & i), xlYes) = tabdyna1(i, nbcf2 - 2)
        Worksheets(chaine4).Add(xlSrcRange, Range("E" & i), xlYes) = tabdyna1(i, nbcf2 - 1)
        Worksheets(chaine4).Add(xlSrcRange, Range("F" & i), xlYes) = tabdyna1(i, nbcf2)
 
Next i
 
End Sub

Les variables définies pour les "form" par l'utiliseur est soit disant non définie ... Heu de compilateur VBA dérouille complément 8O , j'ai déclaré les form comme indiqué !!!!!!!!!!!!!!!!!!!

Pour preuve à parti de la ligne 164 , les " Dim MyFormX As Form" sont bien déclarés .... A ce niveau la je séche complétement. Je m'arrahce les cheveux avec les erreurs sorties de nul part par le compilateur :arf:

Merci de l'aiguillage. ;)

Bonjour,

J'ai tout retapé le code comme voici :

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
Option Explicit
 
Sub Bouton1_Cliquer()
 
' declaration des variable
 
Dim nbdfic As Integer
Dim nbdfic2 As Integer
Dim nomfic As String
Dim nomfica As String
Dim nomficb As String
Dim nbl As Integer
Dim nbld As Integer
Dim nbc As Integer
Dim nbcd As Integer
Dim nblpun As Integer
Dim nblpund As Integer
Dim nomclass As String
Dim nomclassd As String
Dim nomfeuil As String
Dim nomfeuild As String
Dim i As Integer 'compteur 1
Dim j As Integer 'compteur 2
Dim k As Integer 'compteur 3
Dim derncel As String
Dim dernceld As String
 
' saisir le nombre de fichier
 
nbdfic = InputBox("Saisissez le nombre de fichier à fusionner : ")
 
' ouverture des fichiers de fusions
 
Workbooks.Open Filename:="P:\fichier_fusiona.xlsx"
 
Workbooks.Open Filename:="P:\fichier_fusionb.xlsx"
 
For i = 1 To nbdfic
 
Workbooks.Open Filename:="P:\fichier_donnees" & i & ".xlsx"
 
' onglet A
 
Worksheets("ongleta").Select
 
nbc = 9 ' 1 nombre de colonnes fixe à 9 colonnes
 
nbl = ActiveSheet.UsedRange.Rows.Count ' Donne la dernière ligne d'une plage de cellules renseignées à partir de la ligne NoLigne, colonne Col
' nombre de ligne variable
 
nblpun = nbl + 1
 
derncel = Range("A2").SpecialCells(xlCellTypeLastCell).Address 'Donne l'adresse absolue de la dernière cellule renseignée de la feuille
 
Range("A1:" & derncel).Select ' 2 copie la selection variable
 
Selection.Copy '  3 copier la selection
 
Windows("fusiona").Activate
 
Range("A" & nblpun).Select
 
ActiveSheet.Paste
 
' onglet B
 
Worksheets("ongletb").Select
 
nbcd = 6 ' 1 nombre de colonnes fixe à 9 colonnes
 
nbld = ActiveSheet.UsedRange.Rows.Count ' Donne la dernière ligne d'une plage de cellules renseignées à partir de la ligne NoLigne, colonne Col
' nombre de ligne variable
 
nblpund = nbld + 1
 
dernceld = Range("A2").SpecialCells(xlCellTypeLastCell).Address 'Donne l'adresse absolue de la dernière cellule renseignée de la feuille
 
Range("A1:" & dernceld).Select ' 2 copie la selection variable
 
Selection.Copy '  3 copier la selection
 
Windows("fusionb").Activate
 
Range("A" & nblpund).Select
 
ActiveSheet.Paste
 
Next i
 
End Sub

Par contre ici mes instructions "Windows("feuillebiduletruc").Activate" ne sont pas lu et le programme plante .

Une idée ?

Merci de l'aiguillage :koi:

05/11/2015, 15h16
Theze
Bonjour,

Attention avec UsedRange, le résultat retourné peut être surprenant !!!
Code:

1 2 nbl = ActiveSheet.UsedRange.Rows.Count ' Donne la dernière ligne d'une plage de cellules renseignées à partir de la ligne NoLigne, colonne Col
Il suffit que plus bas dans la feuille tu es seulement coloré une cellule ou simplement changée sa fonte et même si tu reviens au format d'avant, ce sera elle qui va servir de référence et quand je vois le commentaire, je doute que se soit ce que tu veux !
Code:

1 2 Windows("fusiona").Activate
Dans ce cas, il te faux écrire le nom complet avec l'extention donc, probablement :
Code:

1 2 Windows("fusiona.xlsx").Activate
je voulais dire "que.... tu aies seulement coloré une cellule ou simplement changé"
05/11/2015, 15h29
Invité
Bonjour,

Merci pour votre retour,
Citation:
Envoyé par Theze

Attention avec UsedRange, le résultat retourné peut être surprenant !!!

Code:

1 2 nbl = ActiveSheet.UsedRange.Rows.Count ' Donne la dernière ligne d'une plage de cellules renseignées à partir de la ligne NoLigne, colonne Col

Il suffit que plus bas dans la feuille tu es seulement coloré une cellule ou simplement changée sa fonte et même si tu reviens au format d'avant, ce sera elle qui va servir de référence et quand je vois le commentaire, je doute que se soit ce que tu veux !
L'instruction vient d'ici même : http://www.google.fr/url?sa=t&rct=j&...449,bs.1,d.ZWU .

Ce que je recherche c'est la dernière ligne avec de la data saisie. ;)
Citation:
Envoyé par Theze

Code:

1 2 Windows("fusiona").Activate

Dans ce cas, il te faux écrire le nom complet avec l'extention donc, probablement :

Code:

1 2 Windows("fusiona.xlsx").Activate
Attention "fusiona" est le nom d'un onglet/d'une feuille d'un classeur. L'onglet "fusiona" est dans le fichier "fichier_fusiona.xlsx". C'est pas plutôt worksheet ou sheet du coup ?

De cette façon :

Code:

1
2
 
Workbooks("fichier_fusiona.xlsx").Worksheets("fusiona").Activate

Bonsoir ,

Tout d'abord merci à tous de votre participation.

Après mainte retouche et divers bricolage sur le code voici ce que fait celui ci :

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
Option Explicit
 
Sub Bouton1_Cliquer()
 
' declaration des variable
 
Dim nbdfic As Integer
Dim nomfic As String
Dim nomfica As String
Dim nomficb As String
Dim nbldanfic As Integer
Dim nblexist As Integer
Dim nblexistpun As Integer
Dim nblajout As Integer
Dim nblnvpos As Integer
Dim nblnvpospun As Integer
Dim nbldecal As Integer
Dim nbc As Integer
Dim i As Integer 'compteur 1
Dim j As Integer 'compteur 2
Dim k As Integer 'compteur 3
Dim derncel As String
Dim wbk As Workbook
 
 
' saisir le nombre de fichier
 
nbdfic = InputBox("Saisissez le nombre de fichier à fusionner : ")
 
' ouverture des fichiers de fusions
 
Workbooks.Open Filename:="P:\fichier_fusiona.xlsx"
 
'Workbooks.Open Filename:="P:\fichier_fusionb.xlsx"
 
nblexist = -2
nblexistpun = 0
nblajout = 0
nblnvpos = 0
nblnvpospun = 0
nbldecal = 1
 
' onglet A
 
For i = 1 To nbdfic
 
Workbooks.Open Filename:="P:\fichier_donnees" & i & ".xlsx"
 
Set wbk = ThisWorkbook
 
Worksheets("ongleta").Select
 
nbc = 9 ' 1 nombre de colonnes fixe à 9 colonnes
 
nbldanfic = ActiveSheet.UsedRange.Rows.Count ' Donne la dernière ligne d'une plage de cellules renseignées à partir de la ligne NoLigne, colonne Col
nblexist = Workbooks("fichier_fusiona.xlsx").Worksheets("fusiona").UsedRange.Rows.Count
 
' nombre de ligne variable
 
nblexistpun = nblexist + nbldecal
nblnvpos = nblexist + nbldanfic
nblnvpospun = nblnvpos + nbldecal
 
' addition a voir  ?????????????????????????
 
derncel = Range("A1").SpecialCells(xlCellTypeLastCell).Address 'Donne l'adresse absolue de la dernière cellule renseignée de la feuille
 
Range("A1:" & derncel).Select ' 2 copie la selection variable
 
Selection.Copy '  3 copier la selection
 
Workbooks("fichier_fusiona.xlsx").Worksheets("fusiona").Activate
 
nblajout = nblnvpospun + nbldanfic
 
Range("A" & nblnvpospun & ":I" & nblajout).Select
 
ActiveSheet.Paste
 
' Workbooks(Nom_Classeur).Close False 'sans sauvegarde (True si sauvegarde) ' fermer classeur
 
Next i
 
End Sub

Pourriez me modifier ce qui vous semble boiteux ? Le code marche , enfin ! Après rude bataille :aie: Il y a pas de souci vous pouvez le tester .

Merci des aiguillages divers ;)

Bonjour,

Un peu modifié mais pas testé !
J'ai ajouté un contrôle d'existence de fichiers :

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
 
Sub Bouton1_Cliquer()
 
    ' declaration des variable
    Dim nbdfic As Integer
    Dim nbldanfic As Integer
    Dim nblexist As Integer
    Dim nblexistpun As Integer
    Dim nblajout As Integer
    Dim nblnvpos As Integer
    Dim nblnvpospun As Integer
    Dim nbldecal As Integer
    Dim nbc As Integer
    Dim i As Integer 'compteur 1
    Dim derncel As String
    Dim wbk As Workbook
    Dim Cls As Workbook
 
    ' saisir le nombre de fichier
 
    nbdfic = InputBox("Saisissez le nombre de fichier à fusionner : ")
 
    ' ouverture des fichiers de fusions
    If Dir("P:\fichier_fusiona.xlsx") = "" Then Exit Sub
 
    Set Cls = Workbooks.Open("P:\fichier_fusiona.xlsx")
    'Workbooks.Open Filename:="P:\fichier_fusionb.xlsx"
 
    nblexist = -2
    nbldecal = 1
 
    ' onglet A
    For i = 1 To nbdfic
 
        If Dir("P:\fichier_donnees" & i & ".xlsx") <> "" Then
 
            Set wbk = Workbooks.Open("P:\fichier_donnees" & i & ".xlsx")
 
            With wbk.Worksheets("ongleta")
 
                nbc = 9 ' 1 nombre de colonnes fixe à 9 colonnes
 
                nbldanfic = .UsedRange.Rows.Count ' Donne la dernière ligne d'une plage de cellules renseignées à partir de la ligne NoLigne, colonne Col
                nblexist = Cls.Worksheets("fusiona").UsedRange.Rows.Count
 
                ' nombre de ligne variable
                nblexistpun = nblexist + nbldecal
                nblnvpos = nblexist + nbldanfic
                nblnvpospun = nblnvpos + nbldecal
 
                ' addition a voir  ?????????????????????????
 
                derncel = .Range("A1").SpecialCells(xlCellTypeLastCell).Address 'Donne l'adresse absolue de la dernière cellule renseignée de la feuille
 
                nblajout = nblnvpospun + nbldanfic
                ' 2 copie la selection variable
                .Range("A1:" & derncel).Copy Cls.Worksheets("fusiona").Range("A" & nblnvpospun & ":I" & nblajout)
 
            End With
 
        End If
 
        ' Workbooks(Nom_Classeur).Close False 'sans sauvegarde (True si sauvegarde) ' fermer classeur
 
    Next i
 
End Sub

Bonjour,

Après pas mal de bricolage sur mon code que voici que voila , pour permettre de fusionner des divers feuilles de plusieurs classeurs , sur une seule et même feuille :

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
Option Explicit
 
Sub Bouton1_Cliquer()
 
    ' declaration des variable
 
    Dim nbdfic As Integer
    Dim nbldanficfus As Integer
    Dim nbldanficfuspun As Integer
    Dim nbldanficafus As Integer
    Dim nblajout As Integer
    Dim nbldecal As Integer
 
    Dim i As Integer 'compteur 1
    Dim derncel As String
    Dim nbc As Integer
 
    'Dim nblexist As Integer
    'Dim nblexistpun As Integer
    'Dim nblnvpos As Integer
    'Dim nblnvpospun As Integer
    'Dim nbldecal As Integer
 
    Dim wbk As Workbook
    Dim Cls As Workbook
 
    ' saisir le nombre de fichier
 
    nbdfic = InputBox("Saisissez le nombre de fichier à fusionner : ")
 
    ' ouverture des fichiers de fusions
 
    If Dir("P:\fichier_fusiona.xlsx") = "" Then Exit Sub ' / ! \ lien a adapter
    If Dir("P:\fichier_fusionb.xlsx") = "" Then Exit Sub ' / ! \ lien a adapter
 
    Set Cls = Workbooks.Open("P:\fichier_fusiona.xlsx") ' / ! \ lien a adapter
    Set Cls = Workbooks.Open("P:\fichier_fusionb.xlsx") ' / ! \ lien a adapter
 
    nbldecal = 1
 
    ' onglet A
 
    For i = 1 To nbdfic
 
        If i = 1 Then ' particularité ligne 1
 
            Set wbk = Workbooks.Open("P:\fichier_donnees" & i & ".xlsx") ' / ! \ lien a adapter
 
            With wbk.Worksheets("ongleta")
 
            nbc = 9 ' 1 nombre de colonnes fixe à 9 colonnes / ! \ a adapter si necessaire
 
            nbldanficafus = .UsedRange.Rows.Count ' nombre de ligne dans le fichier à fusionner
 
            nbldanficfus = Cls.Worksheets("fusiona").UsedRange.Rows.Count
 
            derncel = .Range("A1").Range("A1").SpecialCells(xlCellTypeLastCell).Address ' Donne l'adresse absolue de la dernière cellule renseignée de la feuille
 
            .Range("A1:I1").Copy Cls.Worksheets("fusiona").Range("A1:I1")
 
            Workbook.Close False ' fermeture fichier
 
            End With
 
        End If
 
        If i >= 2 Then
 
            If Dir("P:\fichier_donnees" & i & ".xlsx") <> "" Then ' / ! \ lien a adapter
 
                Set wbk = Workbooks.Open("P:\fichier_donnees" & i & ".xlsx") ' / ! \ lien a adapter
 
                With wbk.Worksheets("ongleta")
 
                nbc = 9 ' 1 nombre de colonnes fixe à 9 colonnes / ! \ a adapter si necessaire
 
                nbldanficafus = .UsedRange.Rows.Count ' nombre de ligne dans le fichier à fusionner
 
                nbldanficfus = Cls.Worksheets("fusiona").UsedRange.Rows.Count ' nombre de ligne dans le fichier fusionné
 
                derncel = .Range("A1").Range("A1").SpecialCells(xlCellTypeLastCell).Address ' Donne l'adresse absolue de la dernière cellule renseignée de la feuille
 
                ' 2 copie la selection variable
 
                .Range("A1:" & derncel).Copy Cls.Worksheets("fusiona").Range("A" & (nbldanficfus + 1) & ":I" & (nbldanficfus + 2 + nbldanficafus))
 
                ThisWorkbook.Close False ' fermeture fichier
 
                End With
 
            End If
 
        End If
 
     Next i
 
    ' onglet b
 
    For i = 1 To nbdfic
 
        If i = 1 Then ' particularité ligne 1
 
            Set wbk = Workbooks.Open("P:\fichier_donnees" & i & ".xlsx") ' / ! \ lien a adapter
 
            With wbk.Worksheets("ongletb")
 
            nbc = 6 ' 1 nombre de colonnes fixe à 6 colonnes / ! \ a adapter si necessaire
 
            nbldanficafus = .UsedRange.Rows.Count ' nombre de ligne dans le fichier à fusionner
 
            nbldanficfus = Cls.Worksheets("fusionb").UsedRange.Rows.Count
 
            derncel = .Range("A1").Range("A1").SpecialCells(xlCellTypeLastCell).Address ' Donne l'adresse absolue de la dernière cellule renseignée de la feuille
 
            .Range("A1:I1").Copy Cls.Worksheets("fusionb").Range("A1:I1")
 
            Workbook.Close False ' fermeture fichier
 
            End With
 
        End If
 
        If i >= 2 Then
 
            If Dir("P:\fichier_donnees" & i & ".xlsx") <> "" Then ' / ! \ lien a adapter
 
                Set wbk = Workbooks.Open("P:\fichier_donnees" & i & ".xlsx") ' / ! \ lien a adapter
 
                With wbk.Worksheets("ongletb")
 
                nbc = 6 ' 1 nombre de colonnes fixe à 6 colonnes / ! \ a adapter si necessaire
 
                nbldanficafus = .UsedRange.Rows.Count ' nombre de ligne dans le fichier à fusionner
 
                nbldanficfus = Cls.Worksheets("fusiona").UsedRange.Rows.Count ' nombre de ligne dans le fichier fusionné
 
                derncel = .Range("A1").Range("A1").SpecialCells(xlCellTypeLastCell).Address ' Donne l'adresse absolue de la dernière cellule renseignée de la feuille
 
                ' 2 copie la selection variable
 
                .Range("A1:" & derncel).Copy Cls.Worksheets("fusiona").Range("A" & (nbldanficfus + 1) & ":I" & (nbldanficfus + 2 + nbldanficafus))
 
                ThisWorkbook.Close False ' fermeture fichier
 
                End With
 
            End If
 
        End If
 
     Next i
 
End Sub

Merci des aiguillages ;)