Copy a Range from each workbook in a folder using VBA in Microsoft Excel

In this article, we will create a macro to copy data from multiple workbooks in a folder to a new workbook.

We will create two macros; one macro will only copy records from first column to the new workbook and second macro will copy all the data into it.

Raw data for this example consists of attendance records of employees. In the TestFolder, we have multiple Excel files. File names of Excel files represent a particular date in “ddmmyyyy” format.

Each Excel file contains date, employee id and employee name of those employees who were present on that particular day.

We have created two macros; “CopyingSingleColumnData” and “CopyingMultipleColumnData”. “CopyingSingleColumnData” macro will only copy records from the first column of all the files in folder to the new workbook. “CopyingMultipleColumnData” macro will copy all the data from all the files in folder to the new workbook.

“CopyingSingleColumnData” macro can be executed by clicking “Copying Single Column” button. “CopyingMultipleColumnData” macro can be executed by clicking “Copying Multiple Columns” button.

Before running the macro, one has to specify path of the folder in the text box, where Excel files are placed.

When “Copying Single Column” button is clicked, a new workbook "ConsolidatedFile” will be generated in the defined folder. This workbook will contain consolidated data from first column of all the files in the folder.

The new workbook will contain only records in the first column. Once we have the consolidated data, we can find out number of employees present on a particular day by counting the number of date. Count of a particular date will be equal to number of employees present on that particular day.

When “Copying Multiple Columns” button is clicked, it will generate the new workbook "ConsolidatedAllColumns” in the defined folder. This workbook will contain consolidated data from all records of all the files in the folder.

The new workbook created will contain all records from all the files in the folder. Once we have the consolidated data, we have all the attendance details available in a single file. We can easily find the number of employees present on that particular day and also get names of the employees who were present on that particular day.

Code explanation

Sheet1.TextBox1.Value

Above code is used to get the value inserted in the text box “TextBox1” from the sheet “Sheet1”.

Dir(FolderPath & "*.xlsx")

Above code is used to get the name of file, which has file extension “.xlsx”. We have used wildcard * for multiple character file name.

While FileName <> ""

Count1 = Count1 + 1

ReDim Preserve FileArray(1 To Count1)

FileArray(Count1) = FileName

FileName = Dir()

Wend

Above code is used to get file names of all the files in the folder.

For i = 1 To UBound(FileArray)

Next

Above code is used to loop through all the files in the folder.

Range("A1", Cells(LastRow, 1)).Copy DestWB.ActiveSheet.Cells(LastDesRow, 1)

Above code is used to copy record from the first column to the destination workbook.

Range("A1", ActiveCell.SpecialCells(xlCellTypeLastCell)).Copy DestWB.ActiveSheet.Cells(LastDesRow, 1)

Above code is used to copy all the record from the active workbook to the destination workbook.

Please follow below for the 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

If you liked this blog, share it with your friends on Facebook. Also, you can follow us on Twitter and Facebook.

We would love to hear from you, do let us know how we can improve our work and make it better for you. Write to us at info@exceltip.com