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

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 
Dim wbk As Workbook 
Dim wbkd 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" 
 
For i = 1 To nbdfic 
 
Workbooks.Open Filename:="P:\fichier_donnees" & i & ".xlsx" 
 
' onglet A 
 
Set wbk = ThisWorkbook 
 
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 
 
Set wbkd = ThisWorkbook 
 
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