Copier une plage de chaque classeur dans un dossier en utilisant VBA dans Microsoft Excel
Dans cet article, nous allons créer une macro pour copier les données de plusieurs classeurs dans un dossier vers un nouveau classeur.
Nous allons créer deux macros; une macro copiera uniquement les enregistrements de la première colonne vers le nouveau classeur et la seconde macro copiera toutes les données dedans.
Les données brutes pour cet exemple se composent des enregistrements de présence des employés.
Dans le TestFolder, nous avons plusieurs fichiers Excel. Les noms de fichier des fichiers Excel représentent une date particulière au format «jjmmaaaa».
Chaque fichier Excel contient la date, l’identifiant de l’employé et le nom de l’employé des employés qui étaient présents ce jour-là.
Nous avons créé deux macros; «CopyingSingleColumnData» et «CopyingMultipleColumnData». La macro « CopyingSingleColumnData » copiera uniquement les enregistrements de la première colonne de tous les fichiers du dossier vers le nouveau classeur. La macro «CopyingMultipleColumnData» copiera toutes les données de tous les fichiers du dossier vers le nouveau classeur.
La macro «CopyingSingleColumnData» peut être exécutée en cliquant sur le bouton «Copying Single Column». La macro «CopyingMultipleColumnData» peut être exécutée en cliquant sur le bouton «Copying Multiple Columns».
Avant d’exécuter la macro, il faut spécifier le chemin du dossier dans la zone de texte, où les fichiers Excel sont placés.
Lorsque vous cliquez sur le bouton « Copier une colonne unique », un nouveau classeur « ConsolidatedFile » sera généré dans le dossier défini. Ce classeur contiendra les données consolidées de la première colonne de tous les fichiers du dossier.
Le nouveau classeur sera ne contiennent que des enregistrements dans la première colonne. Une fois que nous avons les données consolidées, nous pouvons connaître le nombre d’employés présents un jour donné en comptant le nombre de dates. Le nombre d’une date donnée sera égal au nombre d’employés présents à cette date jour.
Lorsque vous cliquez sur le bouton «Copier plusieurs colonnes», le nouveau classeur «ConsolidatedAllColumns» sera généré dans le dossier défini. Ce classeur contiendra des données consolidées de tous les enregistrements de tous les fichiers du dossier.
Le nouveau classeur créé contiendra tous les enregistrements de tous les fichiers du dossier. Une fois que nous avons les données consolidées, nous avons tous les détails de présence disponibles dans un seul fichier. Nous pouvons facilement trouver le nombre d’employés présents ce jour-là et également obtenir les noms des employés qui étaient présents ce jour-là.
Explication du code
Sheet1.TextBox1.Value Le code ci-dessus est utilisé pour récupérer la valeur insérée dans la zone de texte «TextBox1» à partir de la feuille «Sheet1».
Dir (Chemin du dossier & « * .xlsx »)
Le code ci-dessus est utilisé pour obtenir le nom du fichier, qui a l’extension de fichier «.xlsx». Nous avons utilisé le caractère générique * pour le nom de fichier à plusieurs caractères.
Alors que FileName <> « »
Count1 = Count1 + 1 ReDim Preserve FileArray (1 To Count1)
FileArray (Count1) = FileName FileName = Dir ()
Le code Wend Above est utilisé pour obtenir les noms de fichiers de tous les fichiers du dossier.
Pour i = 1 To UBound (FileArray)
Le code suivant ci-dessus est utilisé pour parcourir tous les fichiers du dossier.
Range (« A1 », Cells (LastRow, 1)). Copier DestWB.ActiveSheet.Cells (LastDesRow, 1)
Le code ci-dessus est utilisé pour copier l’enregistrement de la première colonne vers le classeur de destination.
Range (« A1 », ActiveCell.SpecialCells (xlCellTypeLastCell)). Copiez DestWB.ActiveSheet.Cells (LastDesRow, 1)
Le code ci-dessus est utilisé pour copier tout l’enregistrement du classeur actif vers le classeur de destination.
Veuillez suivre ci-dessous pour le code
Option Explicit Sub CopyingSingleColumnData() 'Declaring variables Dim FileName, FolderPath, FileArray(), FileName1 As String Dim LastRow, LastDesRow, Count1, i As Integer Dim SourceWB, DestWB As Workbook Application.ScreenUpdating = False FolderPath = Sheet1.TextBox1.Value 'Inserting backslash in the folder path if backslash(\) is missing If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\" End If 'Searching for Excel files FileName = Dir(FolderPath & "*.xlsx") Count1 = 0 'Looping through all the Excel files in the folder While FileName <> "" Count1 = Count1 + 1 ReDim Preserve FileArray(1 To Count1) FileArray(Count1) = FileName FileName = Dir() Wend 'Creating a new workbook Set DestWB = Workbooks.Add For i = 1 To UBound(FileArray) 'Finding the last row in the workbook LastDesRow = DestWB.ActiveSheet.Range("A1").SpecialCells(xlCellTypeLastCell).Row 'Opening the Excel workbook Set SourceWB = Workbooks.Open(FolderPath & FileArray(i)) LastRow = ActiveCell.SpecialCells(xlCellTypeLastCell).Row 'Pasting the copied data to last row in the destination workbook If LastDesRow = 1 Then 'Copying the first column to last row in the destination workbook Range("A1", Cells(LastRow, 1)).Copy DestWB.ActiveSheet.Cells(LastDesRow, 1) Else Range("A1", Cells(LastRow, 1)).Copy DestWB.ActiveSheet.Cells(LastDesRow + 1, 1) End If SourceWB.Close False Next 'Saving and closing a new Excel workbook DestWB.SaveAs FileName:=FolderPath & "ConsolidatedFile.xlsx" DestWB.Close Set DestWB = Nothing Set SourceWB = Nothing End Sub Sub CopyingMultipleColumnData() 'Declaring variables Dim FileName, FolderPath, FileArray(), FileName1 As String Dim LastRow, LastDesRow, Count1, i As Integer Dim SourceWB, DestWB As Workbook Application.ScreenUpdating = False FolderPath = Sheet1.TextBox1.Value 'Inserting backslash in the folder path if backslash(\) is missing If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\" End If 'Searching for Excel files FileName = Dir(FolderPath & "*.xlsx") Count1 = 0 'Looping through all the Excel files in the folder While FileName <> "" Count1 = Count1 + 1 ReDim Preserve FileArray(1 To Count1) FileArray(Count1) = FileName FileName = Dir() Wend 'Creating a new workbook Set DestWB = Workbooks.Add For i = 1 To UBound(FileArray) 'Finding the last row in the workbook LastDesRow = DestWB.ActiveSheet.Range("A1").SpecialCells(xlCellTypeLastCell).Row 'Opening the Excel workbook Set SourceWB = Workbooks.Open(FolderPath & FileArray(i)) 'Pasting the copied data to last row in the destination workbook If LastDesRow = 1 Then 'Copying all data in the worksheet to last row in the destination workbook Range("A1", ActiveCell.SpecialCells(xlCellTypeLastCell)).Copy DestWB.ActiveSheet.Cells(LastDesRow, 1) Else Range("A1", ActiveCell.SpecialCells(xlCellTypeLastCell)).Copy DestWB.ActiveSheet.Cells(LastDesRow + 1, 1) End If SourceWB.Close False Next 'Saving and closing a new Excel workbook DestWB.SaveAs FileName:=FolderPath & "ConsolidatedAllColumns.xlsx" DestWB.Close Set DestWB = Nothing Set SourceWB = Nothing End Sub
Si vous avez aimé ce blog, partagez-le avec vos amis sur Facebook et Facebook.
Nous serions ravis de vous entendre, faites-nous savoir comment nous pouvons améliorer notre travail et l’améliorer pour vous. Écrivez-nous à [email protected]