fusion des fichiers en 1 fichier

fusion des fichiers en 1 fichier - VB/VBA/VBS - Programmation

Marsh Posté le 05-11-2015 à 15:16:39    

Bonjour,  
 
Cela fait une semaine que je m'arrache les cheveux , pour copier des données dans des fichiers numérotés 1 à 5 se trouvant dans des onglets portant le nom "ongletA" tous.
 
fichier1;ongletA
fichier2;ongletA
fichier3;ongletA
fichier4;ongletA
fichier5;ongletA
 
>> vers >>
 
fichierfusion;ongletfusionA
 
Je dois fusionner le tout dans un fichier ou on empile les données sur un seul et même onglet les une à la suite des autres.  
 
Voici le code VBA que j'ai tappé :  
 

Code :
  1. Option Explicit
  2.  
  3. Public Sub fusion_Click()
  4.  
  5. ' les variables
  6.  
  7. ' variables pour les feuilles de classeurs et les classeurs
  8.  
  9. Dim onglet_fusionA As Worksheet
  10. Dim onglet_fusionb As Worksheet
  11. Dim fichier_fusionA As Workbook
  12. Dim fichier_fusionB As Workbook
  13.  
  14. ' variables pour les nb de ligne d'une feuille
  15.  
  16. Dim nblf1 As Integer
  17. Dim nblf2 As Integer
  18. Dim nblf3 As Integer
  19. Dim nblf4 As Integer
  20. Dim nblf5 As Integer
  21. Dim nblf6 As Integer
  22. Dim nblf7 As Integer
  23. Dim nblf8 As Integer
  24. Dim nblf9 As Integer
  25. Dim nblf10 As Integer
  26.  
  27. Dim nblent1 As Integer
  28. Dim nblent2 As Integer
  29. Dim nblent3 As Integer
  30. Dim nblent4 As Integer
  31. Dim nblent5 As Integer
  32. Dim nblent6 As Integer
  33. Dim nblent7 As Integer
  34. Dim nblent8 As Integer
  35. Dim nblent9 As Integer
  36. Dim nblent10 As Integer
  37.  
  38. ' variables pour les nb de ligne total
  39.  
  40. Dim nbltot1 As Integer
  41. Dim nbltot2 As Integer
  42. Dim nbltot3 As Integer
  43. Dim nbltot4 As Integer
  44. Dim nbltot5 As Integer
  45. Dim nbltot6 As Integer
  46. Dim nbltot7 As Integer
  47. Dim nbltot8 As Integer
  48. Dim nbltot9 As Integer
  49. Dim nbltot10 As Integer
  50.  
  51. ' variables pour les nb de colonne d'une feuille
  52.  
  53. Dim nbcf1 As Integer
  54. Dim nbcf2 As Integer
  55. Dim nbcf3 As Integer
  56. Dim nbcf4 As Integer
  57. Dim nbcf5 As Integer
  58. Dim nbcf6 As Integer
  59. Dim nbcf7 As Integer
  60. Dim nbcf8 As Integer
  61. Dim nbcf9 As Integer
  62. Dim nbcf10 As Integer
  63.  
  64. Dim nbcent1 As Integer
  65. Dim nbcent2 As Integer
  66. Dim nbcent3 As Integer
  67. Dim nbcent4 As Integer
  68. Dim nbcent5 As Integer
  69. Dim nbcent6 As Integer
  70. Dim nbcent7 As Integer
  71. Dim nbcent8 As Integer
  72. Dim nbcent9 As Integer
  73. Dim nbcent10 As Integer
  74.  
  75. ' variables pour les nb de colonne total
  76.  
  77. Dim nbctot1 As Integer
  78. Dim nbctot2 As Integer
  79. Dim nbctot3 As Integer
  80. Dim nbctot4 As Integer
  81. Dim nbctot5 As Integer
  82. Dim nbctot6 As Integer
  83. Dim nbctot7 As Integer
  84. Dim nbctot8 As Integer
  85. Dim nbctot9 As Integer
  86. Dim nbctot10 As Integer
  87.  
  88. ' declaration de variable compteur
  89.  
  90. Dim i As Integer
  91. Dim j As Integer
  92. Dim k As Integer
  93. Dim l As Integer
  94.  
  95. Dim cpt1 As Integer
  96. Dim cpt2 As Integer
  97.  
  98. Dim nblp1 As Integer
  99. Dim nblp2 As Integer
  100. Dim nblp3 As Integer
  101. Dim nblp4 As Integer
  102. Dim nblp5 As Integer
  103. Dim nblp6 As Integer
  104. Dim nblp7 As Integer
  105. Dim nblp8 As Integer
  106. Dim nblp9 As Integer
  107. Dim nblp10 As Integer
  108.  
  109. ' variable pour l utilisation des chaines de caractères
  110.  
  111. Dim chaine1 As String
  112. Dim chaine2 As String
  113. Dim chaine3 As String
  114. Dim chaine4 As String
  115. Dim chaine5 As String
  116. Dim chaine6 As String
  117. Dim chaine7 As String
  118. Dim chaine8 As String
  119. Dim chaine9 As String
  120. Dim chaine10 As String
  121.  
  122. ' variable pour les classeurs
  123.  
  124. Dim wbk1 As Workbook
  125. Dim wbk2 As Workbook
  126. Dim wbk3 As Workbook
  127. Dim wbk4 As Workbook
  128. Dim wbk5 As Workbook
  129. Dim wbk6 As Workbook
  130. Dim wbk7 As Workbook
  131. Dim wbk8 As Workbook
  132. Dim wbk9 As Workbook
  133. Dim wbk10 As Workbook
  134.  
  135. Dim wbkf1 As Workbook
  136. Dim wbkf2 As Workbook
  137.  
  138. ' variable pour des objets
  139.  
  140. Dim xlsApp1 As Object
  141. Dim xlsApp2 As Object
  142.  
  143. ' creation de tableaux à taille dynamique pour le deplacement des morceaux de tableau par bloc
  144.  
  145. Dim tabdyna1()
  146. Dim tabdyna2()
  147. Dim tabdyna3()
  148. Dim tabdyna4()
  149.  
  150. ' creation des formulaires
  151.  
  152. ' traitement feuille de classeur
  153.  
  154. Dim MyForm1 As Form
  155. Dim MyForm2 As Form
  156. Dim MyForm3 As Form
  157. Dim MyForm4 As Form
  158. Dim MyForm5 As Form
  159. Dim MyForm6 As Form
  160. Dim MyForm7 As Form
  161. Dim MyForm8 As Form
  162. Dim MyForm9 As Form
  163. Dim MyForm10 As Form
  164.  
  165. ' fusion finale
  166.  
  167. Dim MyForm1f As Form
  168. Dim MyForm2f As Form
  169. Dim MyForm3f As Form
  170. Dim MyForm4f As Form
  171. Dim MyForm5f As Form
  172. Dim MyForm6f As Form
  173. Dim MyForm7f As Form
  174. Dim MyForm8f As Form
  175. Dim MyForm9f As Form
  176. Dim MyForm10f As Form
  177.  
  178. ' 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 .
  179.  
  180. ActiveWorkbook.Worksheets("ongleta" ).Activate
  181. 'wb.Worksheets("Gestion_Boite" ).Activate
  182.     nblent1 = ActiveSheet.UsedRange.Rows.Count
  183.     nbcent1 = ActiveSheet.UsedRange.Columns.Count
  184.  
  185. ' rangement dans le tableau a taille variable , on ne sait pas combien de lignes seront empilées ...
  186.  
  187. ReDim tabdyna1(1, 0)
  188. tabdyna1(1, 0) = Range("A" & 1)
  189. ReDim tabdyna1(1, 1)
  190. tabdyna1(1, 1) = Range("B" & 1)
  191. ReDim tabdyna1(1, 2)
  192. tabdyna1(1, 2) = Range("C" & 1)
  193. ReDim tabdyna1(1, 3)
  194. tabdyna1(1, 3) = Range("D" & 1)
  195. ReDim tabdyna1(1, 4)
  196. tabdyna1(1, 4) = Range("E" & 1)
  197. ReDim tabdyna1(1, 5)
  198. tabdyna1(1, 5) = Range("F" & 1)
  199. ReDim tabdyna1(1, 6)
  200. tabdyna1(1, 6) = Range("G" & 1)
  201. ReDim tabdyna1(1, 7)
  202. tabdyna1(1, 7) = Range("H" & 1)
  203. ReDim tabdyna1(1, 8)
  204. tabdyna1(1, 8) = Range("I" & 1)
  205. cpt1 = nblent1
  206.  
  207. ' calcul du nombre de lignes et colonnes du fichier d'entete (onglet B)
  208. ActiveWorkbook.Worksheets("ongletb" ).Activate
  209.  
  210. 'ActiveWorkbook.Sheets ("ongletb" )
  211.    nblent2 = ActiveSheet.UsedRange.Rows.Count
  212.    nbcent2 = ActiveSheet.UsedRange.Columns.Count
  213.  
  214. ' rangement dans le tableau a taille variable , on ne sait pas combien de lignes seront empilées ..
  215.  
  216. ReDim tabdyna2(1, 0)
  217. tabdyna2(1, 0) = Range("A" & 1)
  218. ReDim tabdyna2(1, 1)
  219. tabdyna2(1, 1) = Range("B" & 1)
  220. ReDim tabdyna2(1, 2)
  221. tabdyna2(1, 2) = Range("C" & 1)
  222. ReDim tabdyna2(1, 3)
  223. tabdyna2(1, 3) = Range("D" & 1)
  224. ReDim tabdyna2(1, 4)
  225. tabdyna2(1, 4) = Range("E" & 1)
  226. ReDim tabdyna2(1, 5)
  227. tabdyna2(1, 5) = Range("F" & 1)
  228.  
  229. cpt2 = nblent2
  230.  
  231. ' fichier de donnees
  232.  
  233. 'fichier 1
  234.  
  235. ' fichier 1 onglet A
  236.  
  237. wbk1 = Workbooks.Open(Filename:="P:\fichier_donnees1.xlsx" )
  238.  
  239.  
  240.  
  241. wbk1.Worksheets("ongleta" ).Activate
  242. nblf1 = ActiveSheet.UsedRange.Rows.Count
  243. nbcf1 = ActiveSheet.UsedRange.Columns.Count
  244.  
  245. Set MyForm1 = Form1
  246.  
  247. For i = (cpt1 + 1) To nblf1 ' toujour un remplissage à la ligne ligne+1
  248.  
  249. MyForm.Command1.Caption = i
  250.  
  251. DoEvents
  252.  
  253. ReDim tabdyna1(nblf1, nbcf1 - 8)
  254. tabdyna1(nblf1, nbcf1 - 8) = Range("A" & nblf1)
  255. ReDim tabdyna1(nblf1, nbcf1 - 7)
  256. tabdyna1(nblf1, nbcf1 - 7) = Range("B" & nblf1)
  257. ReDim tabdyna1(nblf1, nbcf1 - 6)
  258. tabdyna1(nblf1, nbcf1 - 6) = Range("C" & nblf1)
  259. ReDim tabdyna1(nblf1, nbcf1 - 5)
  260. tabdyna1(nblf1, nbcf1 - 5) = Range("D" & nblf1)
  261. ReDim tabdyna1(nblf1, nbcf1 - 4)
  262. tabdyna1(nblf1, nbcf1 - 4) = Range("E" & nblf1)
  263. ReDim tabdyna1(nblf1, nbcf1 - 3)
  264. tabdyna1(nblf1, nbcf1 - 3) = Range("F" & nblf1)
  265. ReDim tabdyna1(nblf1, nbcf1 - 2)
  266. tabdyna1(nblf1, nbcf1 - 2) = Range("G" & nblf1)
  267. ReDim tabdyna1(nblf1, nbcf1 - 1)
  268. tabdyna1(nblf1, nbcf1 - 1) = Range("H" & nblf1)
  269. ReDim tabdyna1(nblf1, nbcf1)
  270. tabdyna1(nblf1, nbcf1) = Range("I" & nblf1)
  271.  
  272. Next i
  273.  
  274. cpt1 = cpt1 + nblf1
  275.  
  276. ' fichier 1 onglet B
  277.  
  278. wbk2 = Workbooks.Open(Filename:="P:\fichier_donnees1.xlsx" )
  279.  
  280. wbk2.Worksheets("ongletb" ).Activate
  281. nblf2 = ActiveSheet.UsedRange.Rows.Count
  282. nbcf2 = ActiveSheet.UsedRange.Columns.Count
  283.  
  284. Set MyForm2 = Form2
  285.  
  286. For i = (cpt2 + 1) To nblf2 ' toujour un remplissage à la ligne ligne+1
  287.  
  288. MyForm.Command2.Caption = i2
  289.  
  290. DoEvents
  291.  
  292. ReDim tabdyna2(nblf2, nbcf2 - 5)
  293. tabdyna2(nblf2, nbcf2 - 5) = Range("A" & nblf2)
  294. ReDim tabdyna2(nblf2, nbcf2 - 4)
  295. tabdyna2(nblf2, nbcf2 - 4) = Range("B" & nblf2)
  296. ReDim tabdyna2(nblf2, nbcf2 - 3)
  297. tabdyna2(nblf2, nbcf2 - 3) = Range("C" & nblf2)
  298. ReDim tabdyna2(nblf2, nbcf2 - 2)
  299. tabdyna2(nblf2, nbcf2 - 2) = Range("D" & nblf2)
  300. ReDim tabdyna2(nblf2, nbcf2 - 1)
  301. tabdyna2(nblf2, nbcf2 - 1) = Range("E" & nblf2)
  302. ReDim tabdyna2(nblf2, nbcf2)
  303. tabdyna2(nblf2, nbcf2) = Range("F" & nblf2)
  304.  
  305. Next i
  306.  
  307. cpt2 = cpt2 + nblf2
  308.  
  309. 'fin traitement fichier donnees 1
  310.  
  311. 'fin d'import des données dans les feuilles excel dans les tableaux virtuels dynamiques
  312.  
  313. ' nommination des futures feuilles et classeurs excel
  314.  
  315. chaine1 = "P:\fusion_ongleta.xlsx"
  316. chaine2 = "P:\fusion_ongletb.xlsx"
  317. chaine3 = "ongleta"
  318. chaine4 = "ongletb"
  319.  
  320. ' creation des fichiers de sorties
  321.  
  322. 'xlApp1 = CreateObject("Excel.Application", chaine1)
  323. 'xlApp2 = CreateObject("Excel.Application", chaine2)
  324.  
  325. ' ouverture des fichiers excel nouvellement créés
  326.  
  327. Set wbkf1 = Workbooks.Open(Filename:=chaine1)
  328. 'xlSheet1 = xlApp1.Createworksheets(chaine3)
  329. Set wbkf1 = ThisWorkbook
  330. 'wbkf1.Worksheets("ongleta" ).Activate
  331. wbk1.Worksheets("ongleta" ).Activate
  332.  
  333. Set wbkf2 = Workbooks.Open(Filename:=chaine2)
  334. 'xlSheet2 = xlApp2.Createworksheets(chaine4)
  335. Set wbkf2 = ThisWorkbook
  336. 'wbkf2.Worksheets("ongletb" ).Activate
  337. wbk2.Worksheets("ongletb" ).Activate
  338.  
  339.  
  340. ' compacter les lignes dans les feuilles créés
  341.  
  342. ' onglet de fusion A >> injection des données
  343.  
  344. Set MyForm1f = Form1f
  345.  
  346. For i = 1 To cpt1  ' ligne par ligne
  347.  
  348. MyForm.Command1f.Caption = i
  349.  
  350. DoEvents
  351.  
  352.        Worksheets(chaine3).Add(xlSrcRange, Range("A" & i)) = tabdyna1(i, nbcf1 - 8)
  353.        Worksheets(chaine3).Add(xlSrcRange, Range("B" & i)) = tabdyna1(i, nbcf1 - 7)
  354.        Worksheets(chaine3).Add(xlSrcRange, Range("C" & i)) = tabdyna1(i, nbcf1 - 6)
  355.        Worksheets(chaine3).Add(xlSrcRange, Range("D" & i)) = tabdyna1(i, nbcf1 - 5)
  356.        Worksheets(chaine3).Add(xlSrcRange, Range("E" & i)) = tabdyna1(i, nbcf1 - 4)
  357.        Worksheets(chaine3).Add(xlSrcRange, Range("F" & i)) = tabdyna1(i, nbcf1 - 3)
  358.        Worksheets(chaine3).Add(xlSrcRange, Range("G" & i)) = tabdyna1(i, nbcf1 - 2)
  359.        Worksheets(chaine3).Add(xlSrcRange, Range("H" & i)) = tabdyna1(i, nbcf1 - 1)
  360.        Worksheets(chaine3).Add(xlSrcRange, Range("I" & i)) = tabdyna1(i, nbcf1)
  361.  
  362. Next i
  363.  
  364. ' onglet de fusion B >> injection des données
  365.  
  366. Set MyForm2f = Form2f
  367.  
  368. For i = 1 To cpt2  ' ligne par ligne
  369.  
  370. MyForm.Command2f.Caption = i
  371.  
  372. DoEvents
  373.  
  374.        Worksheets(chaine4).Add(xlSrcRange, Range("A" & i), xlYes) = tabdyna1(i, nbcf2 - 5)
  375.        Worksheets(chaine4).Add(xlSrcRange, Range("B" & i), xlYes) = tabdyna1(i, nbcf2 - 4)
  376.        Worksheets(chaine4).Add(xlSrcRange, Range("C" & i), xlYes) = tabdyna1(i, nbcf2 - 3)
  377.        Worksheets(chaine4).Add(xlSrcRange, Range("D" & i), xlYes) = tabdyna1(i, nbcf2 - 2)
  378.        Worksheets(chaine4).Add(xlSrcRange, Range("E" & i), xlYes) = tabdyna1(i, nbcf2 - 1)
  379.        Worksheets(chaine4).Add(xlSrcRange, Range("F" & i), xlYes) = tabdyna1(i, nbcf2)
  380.  
  381. Next i
  382.  
  383. End Sub


 
Il y a un code d'erreur 438 en cours d'éxecution .
 
Afin de contourner ce code d'erreur "438 " qui apparait microsoft propose ceci : https://support.microsoft.com/fr-fr [...] /kb/175616 . Ce code proposé par microsoft est tout bonnement faux ! Pour preuve les " Dim MyFormX As Form" sont bien déclarés plus haut dans mon programme ...
 
Il est tout bonnement scandaleux de la part de microsoft de publier un code faux! A croire que certains sont de véritable bras cassés chez microsoft ! :fou:  
 
J'ai refait mon code pour la n ième fois pour faire marcher le programme. Voici ce que j'obtiens :
 

Code :
  1. Option Explicit
  2. Sub Bouton1_Cliquer()
  3. ' declaration des variable
  4. Dim nbdfic As Integer
  5. Dim nbdfic2 As Integer
  6. Dim nomfic As String
  7. Dim nomfica As String
  8. Dim nomficb As String
  9. Dim nbl As Integer
  10. Dim nbld As Integer
  11. Dim nbc As Integer
  12. Dim nbcd As Integer
  13. Dim nblpun As Integer
  14. Dim nblpund As Integer
  15. Dim nomclass As String
  16. Dim nomclassd As String
  17. Dim nomfeuil As String
  18. Dim nomfeuild As String
  19. Dim i As Integer 'compteur 1
  20. Dim j As Integer 'compteur 2
  21. Dim k As Integer 'compteur 3
  22. Dim derncel As String
  23. Dim dernceld As String
  24. Dim wbk As Workbook
  25. Dim wbkd As Workbook
  26. ' saisir le nombre de fichier
  27. nbdfic = InputBox("Saisissez le nombre de fichier à fusionner : " )
  28. ' ouverture des fichiers de fusions
  29. Workbooks.Open Filename:="P:\fichier_fusiona.xlsx"
  30. Workbooks.Open Filename:="P:\fichier_fusionb.xlsx"
  31. For i = 1 To nbdfic
  32. Workbooks.Open Filename:="P:\fichier_donnees" & i & ".xlsx"
  33. ' onglet A
  34. Set wbk = ThisWorkbook
  35. Worksheets("ongleta" ).Select
  36. nbc = 9 ' 1 nombre de colonnes fixe à 9 colonnes
  37. nbl = ActiveSheet.UsedRange.Rows.Count ' Donne la dernière ligne d'une plage de cellules renseignées à partir de la ligne NoLigne, colonne Col
  38. ' nombre de ligne variable
  39. nblpun = nbl + 1
  40. derncel = Range("A2" ).SpecialCells(xlCellTypeLastCell).Address 'Donne l'adresse absolue de la dernière cellule renseignée de la feuille
  41. Range("A1:" & derncel).Select ' 2 copie la selection variable
  42. Selection.Copy '  3 copier la selection
  43. Windows("fusiona" ).Activate
  44. Range("A" & nblpun).Select
  45. ActiveSheet.Paste
  46. ' onglet B
  47. Set wbkd = ThisWorkbook
  48. Worksheets("ongletb" ).Select
  49. nbcd = 6 ' 1 nombre de colonnes fixe à 9 colonnes
  50. nbld = ActiveSheet.UsedRange.Rows.Count ' Donne la dernière ligne d'une plage de cellules renseignées à partir de la ligne NoLigne, colonne Col
  51. ' nombre de ligne variable
  52. nblpund = nbld + 1
  53. dernceld = Range("A2" ).SpecialCells(xlCellTypeLastCell).Address 'Donne l'adresse absolue de la dernière cellule renseignée de la feuille
  54. Range("A1:" & dernceld).Select ' 2 copie la selection variable
  55. Selection.Copy '  3 copier la selection
  56. Windows("fusionb" ).Activate
  57. Range("A" & nblpund).Select
  58. ActiveSheet.Paste
  59. Next i
  60. End Sub


 
Ici j'ai maintenant les lignes " Windows("mafeuilledecalcul" ).Activate " qui ne fonctionnent pas. Il y a un code d'erreur " 9 " . Microsoft propose pour contourner le problème , de ... mettre cette ligne ! Une véritable hérisie cette histoire !  :o  
 
Si A ne fonctionne pas alors mettez prenez la solution A ! Logique ! ...
 
Merci de m'aiguiller car la séche.  :??:  :sweat:

Reply

Marsh Posté le 05-11-2015 à 15:16:39   

Reply

Marsh Posté le 06-11-2015 à 13:01:49    

 
           Bonjour, bonjour !
 
           Un code d'erreur est à 99,9999% des cas une boulette de conception du programmeur ‼   Comme classiquement l'erreur #9 …
 
           Afficher un code d'erreur c'est bien, indiquer le numéro de la ligne la déclenchant serait judicieux !
 
           Un bon code évite les  Select,  Selection et autres  Activate  souvent source d'erreurs …
 
           Il suffit de pointer directement l'objet (exemple de ce post) ou d'utiliser un bloc  With  (cf aide VBA).
 
           Je n'irai pas plus loin vu car ce sujet est déjà en cours sur un autre forum …
  

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed