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».

ArrowFilesSource

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à.

ArrowRawFile

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.

ArrowMain

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.

ArrowAfterRunningSingleColumnMacro

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.

ArrowOutputAfterRunningSingleMacro

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.

ArrowRunningSecondMacro

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à.

ArrowFileAfterRunningSecondMacro

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]