VBA – Combiner Plusieurs Fichiers Excel en un Seul Classeur

Ce tutoriel vous montrera comment combiner plusieurs fichiers Excel en un seul classeur en VBA.

La création d’un classeur unique à partir de plusieurs classeurs, à l’aide de VBA, nécessite de suivre un certain nombre d’étapes.

• Vous devez sélectionner les classeurs à partir desquels vous souhaitez obtenir les données sources – les fichiers sources.
• Vous devez sélectionner ou créer le classeur dans lequel vous souhaitez placer les données – le fichier de destination.
• Vous devez sélectionner les feuilles des fichiers Source dont vous avez besoin.
• Vous devez indiquer au code où placer les données dans le fichier de destination.

Combiner Toutes les Feuilles de Tous les Classeurs Ouverts dans un Nouveau Classeur en Tant que Feuilles Individuelles

Dans le code ci-dessous, les fichiers dont vous devez copier les informations doivent être ouverts, car Excel va parcourir les fichiers ouverts et copier les informations dans un nouveau classeur. Le code est placé dans le classeur Personnel de Macros.

Ces fichiers sont les SEULS fichiers Excel qui doivent être ouverts.

Sub CombinerPlusieursFichiers()
On Error GoTo eh
'Déclaration des variables pour contenir les objets requis
   Dim wbDestination As Workbook
   Dim wbSource As Workbook
   Dim wsSource As Worksheet
   Dim wb As Workbook
   Dim sh As Worksheet
   Dim strSheetName As String
   Dim strDestName As String
'Désactive la mise à jour de l'écran pour accélérer l'exécution
   Application.ScreenUpdating = False
'Premièrement un classeur de destination est créé
   Set wbDestination = Workbooks.Add
'Récupère le nom du nouveau classeur pour l'exclure de la boucle qui sera exécutée ensuite
   strDestName = wbDestination.Name
'Boucle sur chaque classeur ouvert et extrait les données. Le classeur nouvellement créé et le classeur personnel sont exclus
   For Each wb In Application.Workbooks
      If wb.Name <> strDestName And wb.Name <> "PERSONAL.XLSB" Then
         Set wbSource = wb
         For Each sh In wbSource.Worksheets
            sh.Copy After:=Workbooks(strDestName).Sheets(1)
         Next sh
      End If
   Next wb
'Fermeture de tous les classeur à l'exception du nouveau classeur et du classeur personnel de macros
   For Each wb In Application.Workbooks
      If wb.Name <> strDestName And wb.Name <> "PERSONAL.XLSB" Then
         wb.Close False
      End If
   Next wb

'Supprime la feuille 1 du classeur de destination
   Application.DisplayAlerts = False
   Sheets("Sheet1").Delete
   Application.DisplayAlerts = True
'Nettoyage des objets pour libérer la mémoire
   Set wbDestination = Nothing
   Set wbSource = Nothing
   Set wsSource = Nothing
   Set wb = Nothing
'Active la mise à jour de l'écran
   Application.ScreenUpdating = True
Exit Sub
eh:
   MsgBox Err.Description
End Sub

Cliquez sur la boîte de dialogue Macro pour exécuter la procédure à partir de votre écran Excel.

Votre fichier combiné sera maintenant affiché.

Ce code a parcouru en boucle chaque fichier et a copié la feuille dans un nouveau fichier. Si l’un de vos fichiers comporte plus d’une feuille, il les copiera également, y compris les feuilles vierges !

Combiner Toutes les Feuilles de Tous les Classeurs Ouverts en une Seule Feuille de Calcul dans un Nouveau Classeur

La procédure ci-dessous combine les informations de toutes les feuilles de tous les classeurs ouverts en une seule feuille de calcul dans un nouveau classeur qui est créé.

Les informations de chaque feuille sont collées dans la feuille de destination à la dernière ligne occupée de la feuille de calcul.

Sub CombinerPlusieursFeuilles()
On Error GoTo eh
'Déclaration des variables pour contenir les objets requis
   Dim wbDestination As Workbook
   Dim wbSource As Workbook
   Dim wsDestination As Worksheet
   Dim wb As Workbook
   Dim sh As Worksheet
   Dim strSheetName As String
   Dim strDestName As String
   Dim iRws As Integer
   Dim iCols As Integer
   Dim totRws As Integer
   Dim strEndRng As String
   Dim rngSource As Range
'Désactive la mise à jour de l'écran pour accélérer l'exécution
   Application.ScreenUpdating = False
'Création du nouveau classeur de destination
   Set wbDestination = Workbooks.Add
'Récupère le nom du nouveau classeur pour l'exclure de la boucle qui sera exécutée ensuite
   strDestName = wbDestination.Name
'Boucle sur chaque classeur ouvert pour récupérer les données (Le nouveau classeur et le classeur personnel de macro sont exclus)
   For Each wb In Application.Workbooks
      If wb.Name <> strDestName And wb.Name <> "PERSONAL.XLSB" Then
         Set wbSource = wb
         For Each sh In wbSource.Worksheets
'Récupère le nombre de lignes et de colonnes dans la feuille
            sh.Activate
            ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Activate
            iRws = ActiveCell.Row
            iCols = ActiveCell.Column
'Récupère l'adresse de la dernière cellule de la feuille
            strEndRng = sh.Cells(iRws, iCols).Address
'set the source range to copy
            Set rngSource = sh.Range("A1:" & strEndRng)
'Trouve la dernière ligne dans le classeur de destination
           wbDestination.Activate
           Set wsDestination = ActiveSheet
           wsDestination.Cells.SpecialCells(xlCellTypeLastCell).Select
           totRws = ActiveCell.Row
'Vérifie qu'il y a assez de rangées restantes dans la feuille de destination pour copier les données
           If totRws + rngSource.Rows.Count > wsDestination.Rows.Count Then
               MsgBox "There are not enough rows to place the data in the Consolidation worksheet."
               GoTo eh
           End If
'Ajoute une rangée pour coller les données sur la prochaine ligne vide
           If totRws <> 1 Then totRws = totRws + 1
           rngSource.Copy Destination:=wsDestination.Range("A" & totRws)
      Next sh
   End If
   Next wb
'Fermeture des classeur sauf le classeur de destination et le classeur personnel de macros
   For Each wb In Application.Workbooks
      If wb.Name <> strDestName And wb.Name <> "PERSONAL.XLSB" Then
         wb.Close False
      End If
   Next wb
'Nettoyage des objets pour libérer la mémoire
   Set wbDestination = Nothing
   Set wbSource = Nothing
   Set wsDestination = Nothing
   Set rngSource = Nothing
   Set wb = Nothing
'Active la mise à jour de l'écran
   Application.ScreenUpdating = True
Exit Sub
eh:
MsgBox Err.Description
End Sub

Combiner Toutes les Feuilles de Tous les Classeurs Ouverts en une Seule Feuille de Calcul dans un Classeur Actif

Si vous souhaitez intégrer les informations de tous les autres classeurs ouverts dans celui dans lequel vous travaillez actuellement, vous pouvez utiliser le code ci-dessous.

Sub CombinerPlusieursFeuilleDansClasseurExistant()
   On Error GoTo eh
'Déclaration des variables pour contenir les objets requis
   Dim wbDestination As Workbook
   Dim wbSource As Workbook
   Dim wsDestination As Worksheet
   Dim wb As Workbook
   Dim sh As Worksheet
   Dim strSheetName As String
   Dim strDestName As String
   Dim iRws As Integer
   Dim iCols As Integer
   Dim totRws As Integer
   Dim rngEnd As String
   Dim rngSource As Range
'Défini le classeur actif en tant que classeur de destination
   Set wbDestination = ActiveWorkbook
'Récupère le nom du classeur actif
   strDestName = wbDestination.Name
'Désactive la mise à jour de l'écran pour accélérer l'exécution
   Application.ScreenUpdating = False
'Création d'une nouvelle feuille de destination dans le classeur actif
   Application.DisplayAlerts = False
'Ignore les erreurs dans le cas où la feuille n'existerait pas
   On Error Resume Next
   ActiveWorkbook.Sheets("Consolidation").Delete
'Réinitialise la gestion des erreurs initiale
   On Error GoTo eh
   Application.DisplayAlerts = True
'Ajoutes une nouvelle feuille au classeur
   With ActiveWorkbook
      Set wsDestination = .Sheets.Add(After:=.Sheets(.Sheets.Count))
      wsDestination.Name = "Consolidation"
   End With
'Boucle sur chaque fichier ouvert pour récupérer les données
   For Each wb In Application.Workbooks
      If wb.Name <> strDestName And wb.Name <> "PERSONAL.XLSB" Then
         Set wbSource = wb
            For Each sh In wbSource.Worksheets
'Récupère le nombre de rangée dans le feuille
               sh.Activate
               ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Activate
               iRws = ActiveCell.Row
               iCols = ActiveCell.Column
               rngEnd = sh.Cells(iRws, iCols).Address
               Set rngSource = sh.Range("A1:" & rngEnd)
'Trouves la dernière rangée dans la feuille de destination
               wbDestination.Activate
               Set wsDestination = ActiveSheet
               wsDestination.Cells.SpecialCells(xlCellTypeLastCell).Select
               totRws = ActiveCell.Row
'Vérifie qu'il y a assez de rangée libre dans la feuille de destination pour coller les données
               If totRws + rngSource.Rows.Count > wsDestination.Rows.Count Then
                  MsgBox "There are not enough rows to place the data in the Consolidation worksheet."
                  GoTo eh
               End If
'Ajoute une rangée pour coller les données dans la prochaine rangée vide
               If totRws <> 1 Then totRws = totRws + 1
               rngSource.Copy Destination:=wsDestination.Range("A" & totRws)
           Next sh
         End If
   Next wb
'Fermeture des classeurs ouverts à l'exception du classeur actif et du classeur personnel
   For Each wb In Application.Workbooks
      If wb.Name <> strDestName And wb.Name <> "PERSONAL.XLSB" Then
         wb.Close False
      End If
   Next wb

'Nettoyage des objets pour libérer la mémoire
   Set wbDestination = Nothing
   Set wbSource = Nothing
   Set wsDestination = Nothing
   Set rngSource = Nothing
   Set wb = Nothing
'Active la mise à jour de l'écran
   Application.ScreenUpdating = True
Exit Sub
eh:
MsgBox Err.Description
End Sub

VBA Coding Made Easy

Stop searching for VBA code online. Learn more about AutoMacro - A VBA Code Builder that allows beginners to code procedures from scratch with minimal coding knowledge and with many time-saving features for all users!


Learn More!