VBA combine plusieurs fichiers Excel dans un seul classeur

Ce didacticiel vous montrera comment combiner plusieurs fichiers Excel dans un seul classeur en VBA

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

  • Vous devez sélectionner les classeurs à partir desquels vous voulez les données source - les fichiers source.
  • Vous devez sélectionner ou créer le classeur dans lequel vous souhaitez mettre 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.

Combinaison de 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 avez besoin pour copier les informations doivent être ouverts car Excel parcourra les fichiers ouverts et copiera les informations dans un nouveau classeur. Le code est placé dans le classeur de macros personnelles.

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

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647 Sub CombineMultipleFiles()En cas d'erreur GoTo hein'déclarer les variables pour contenir les objets requisDim wbDestination comme classeurDim wbSource en tant que classeurDim wsSource en tant que feuille de calculDim wb comme classeurDim sh comme feuille de travailDim strSheetName en tant que chaîneDim strDestName en tant que chaîne'désactive la mise à jour de l'écran pour accélérer les chosesApplication.ScreenUpdating = Faux'créer d'abord un nouveau classeur de destinationDéfinir wbDestination = Workbooks.Add'obtenir le nom du nouveau classeur pour l'exclure de la boucle ci-dessousstrDestName = wbDestination.Nom'maintenant parcourez chacun des classeurs ouverts pour obtenir les données mais excluez votre nouveau livre ou le classeur de macros personnellesPour chaque wb dans Application.WorkbooksSi wb.Name strDestName Et wb.Name "PERSONAL.XLSB" AlorsDéfinir wbSource = wbPour chaque sh dans wbSource.Worksheetssh.Copy After:=Workbooks(strDestName).Sheets(1)Suivant shFin siWb suivant'fermez maintenant tous les fichiers ouverts, à l'exception du nouveau fichier et du classeur de macros personnelles.Pour chaque wb dans Application.WorkbooksSi wb.Name strDestName Et wb.Name "PERSONAL.XLSB" Alorswb.Fermer FauxFin siWb suivant'supprimer la feuille un du classeur de destinationApplication.DisplayAlerts = FauxFeuilles("Feuille1").SupprimerApplication.DisplayAlerts = True'nettoyer les objets pour libérer la mémoireDéfinir wbDestination = RienDéfinir wbSource = RienDéfinir wsSource = RienDéfinir wb = Rien'activer la mise à jour de l'écran une fois terminéApplication.ScreenUpdating = FauxQuitter le sous-marineuh :MsgBox Err.DescriptionFin du sous-marin

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 chaque fichier en boucle et copié la feuille dans un nouveau fichier. Si l'un de vos fichiers a plus d'une feuille - il les copiera également - y compris les feuilles sans rien dessus !

Combinaison de 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 dans une seule feuille de calcul dans un nouveau classeur 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.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869 Sous-combinaisonMultipleSheets()En cas d'erreur GoTo hein'déclarer les variables pour contenir les objets requisDim wbDestination comme classeurDim wbSource en tant que classeurDim wsDestination As WorksheetDim wb comme classeurDim sh comme feuille de travailDim strSheetName en tant que chaîneDim strDestName en tant que chaîneDim iRws en tant qu'entierDiminuer les iCols en tant qu'entierDim totRws en tant qu'entierDim strEndRng en tant que chaîneDim rngSource As Range'désactive la mise à jour de l'écran pour accélérer les chosesApplication.ScreenUpdating = Faux'créer d'abord un nouveau classeur de destinationDéfinir wbDestination = Workbooks.Add'obtenir le nom du nouveau classeur pour l'exclure de la boucle ci-dessousstrDestName = wbDestination.Nom'maintenant parcourez chacun des classeurs ouverts pour obtenir les donnéesPour chaque wb dans Application.WorkbooksSi wb.Name strDestName Et wb.Name "PERSONAL.XLSB" AlorsDéfinir wbSource = wbPour chaque sh dans wbSource.Worksheets'obtenir le nombre de lignes et de colonnes dans la feuillesh.ActiverActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).ActivateiRws = ActiveCell.RowiCols = ActiveCell.Column'définit la plage de la dernière cellule de la feuillestrEndRng = sh.Cells(iRws, iCols).Address'définit la plage source à copierDéfinir rngSource = sh.Range("A1:" & strEndRng)'trouver la dernière ligne dans la feuille de destinationwbDestination.ActiverDéfinir wsDestination = ActiveSheetwsDestination.Cells.SpecialCells(xlCellTypeLastCell).SelecttotRws = ActiveCell.Row'vérifier s'il y a suffisamment de lignes pour coller les donnéesSi totRws + rngSource.Rows.Count > wsDestination.Rows.Count AlorsMsgBox "Il n'y a pas assez de lignes pour placer les données dans la feuille de calcul de consolidation."Allez à heinFin si'ajouter une ligne à coller sur la ligne suivante vers le basSi totRws 1 Alors totRws = totRws + 1rngSource.Copy Destination :=wsDestination.Range("A" & totRws)Suivant shFin siWb suivant'maintenant fermez tous les fichiers ouverts sauf celui que vous voulezPour chaque wb dans Application.WorkbooksSi wb.Name strDestName Et wb.Name "PERSONAL.XLSB" Alorswb.Fermer FauxFin siWb suivant'nettoyer les objets pour libérer la mémoireDéfinir wbDestination = RienDéfinir wbSource = RienDéfinir wsDestination = RienDéfinir rngSource = RienDéfinir wb = Rien'activer la mise à jour de l'écran une fois terminéApplication.ScreenUpdating = FauxQuitter le sous-marineuh :MsgBox Err.DescriptionFin du sous-marin

Combinaison de toutes les feuilles de tous les classeurs ouverts en une seule feuille de calcul dans un classeur actif

Si vous souhaitez importer les informations de tous les autres classeurs ouverts dans celui dans lequel vous travaillez actuellement, vous pouvez utiliser ce code ci-dessous.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081 Sub CombineMultipleSheetsToExisting()En cas d'erreur GoTo hein'déclarer les variables pour contenir les objets requisDim wbDestination comme classeurDim wbSource en tant que classeurDim wsDestination As WorksheetDim wb comme classeurDim sh comme feuille de travailDim strSheetName en tant que chaîneDim strDestName en tant que chaîneDim iRws en tant qu'entierDiminuer les iCols en tant qu'entierDim totRws en tant qu'entierDim rngEnd As StringDim rngSource As Range'définit l'objet classeur actif pour le livre de destinationDéfinir wbDestination = ActiveWorkbook'obtenir le nom du fichier actifstrDestName = wbDestination.Nom'désactive la mise à jour de l'écran pour accélérer les chosesApplication.ScreenUpdating = Faux'créez d'abord une nouvelle feuille de calcul de destination dans votre classeur actifApplication.DisplayAlerts = Faux'reprendre la prochaine erreur si la feuille n'existe pasEn cas d'erreur Reprendre ensuiteActiveWorkbook.Sheets("Consolidation").Supprimer'réinitialiser le piège d'erreur pour aller au piège d'erreur à la finEn cas d'erreur GoTo heinApplication.DisplayAlerts = True'ajouter une nouvelle feuille au classeurAvec ActiveWorkbookDéfinir wsDestination = .Sheets.Add(After :=.Sheets(.Sheets.Count))wsDestination.Name = "Consolidation"Terminer par'maintenant parcourez chacun des classeurs ouverts pour obtenir les donnéesPour chaque wb dans Application.WorkbooksSi wb.Name strDestName Et wb.Name "PERSONAL.XLSB" AlorsDéfinir wbSource = wbPour chaque sh dans wbSource.Worksheets'obtenir le nombre de lignes dans la feuillesh.ActiverActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).ActivateiRws = ActiveCell.RowiCols = ActiveCell.ColumnrngEnd = sh.Cells(iRws, iCols).AddressDéfinir rngSource = sh.Range("A1:" & rngEnd)'trouver la dernière ligne dans la feuille de destinationwbDestination.ActiverDéfinir wsDestination = ActiveSheetwsDestination.Cells.SpecialCells(xlCellTypeLastCell).SelecttotRws = ActiveCell.Row'vérifie s'il y a suffisamment de lignes pour coller les donnéesSi totRws + rngSource.Rows.Count > wsDestination.Rows.Count AlorsMsgBox "Il n'y a pas assez de lignes pour placer les données dans la feuille de calcul de consolidation."Allez à heinFin si'ajouter une ligne à coller sur la ligne suivante si vous n'êtes pas dans la ligne 1Si totRws 1 Alors totRws = totRws + 1rngSource.Copy Destination :=wsDestination.Range("A" & totRws)Suivant shFin siWb suivant'maintenant fermez tous les fichiers ouverts sauf celui que vous voulezPour chaque wb dans Application.WorkbooksSi wb.Name strDestName Et wb.Name "PERSONAL.XLSB" Alorswb.Fermer FauxFin siWb suivant'nettoyer les objets pour libérer la mémoireDéfinir wbDestination = RienDéfinir wbSource = RienDéfinir wsDestination = RienDéfinir rngSource = RienDéfinir wb = Rien'activer la mise à jour de l'écran une fois terminéApplication.ScreenUpdating = FauxQuitter le souseuh :MsgBox Err.DescriptionFin du sous-marin

Vous contribuerez au développement du site, partager la page avec vos amis

wave wave wave wave wave