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.

ArrowFilesSource

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

ArrowRawFile

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.

ArrowMain

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.

ArrowAfterRunningSingleColumnMacro

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.

ArrowOutputAfterRunningSingleMacro

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.

ArrowRunningSecondMacro

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.

ArrowFileAfterRunningSecondMacro

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

Users are saying about us...

  1. Hi there!
    I have a folder with a variable number of workbooks in. I need to copy data from a variable length range in cells DA:DC in each workbook and make them into a list in a Master workbook. I think your "Sub CopyingMultipleColumnData()" will do what I want although it currently creates aa new workbook to paste the copied data into.
    As I'm only looking at copying a selection of data rather than everything in the workbooks I changed the lines
    '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
    to
    'Copying all data in the worksheet to last row in the destination workbook
    Range("DA1:DC", ActiveCell.SpecialCells(xlCellTypeLastCell)).Copy DestWB.ActiveSheet.Cells(LastDesRow, 1)
    Else
    Range("DA1:DC", ActiveCell.SpecialCells(xlCellTypeLastCell)).Copy DestWB.ActiveSheet.Cells(LastDesRow + 1, 1)
    End If
    Problem is when the code reaches these lines if throws up a 1004 - "Application defined or Object defined error" message.

    A couple of questions:
    1. What am I doing wrong that causes this error?
    2. what do I need to change in the code to save the copied data to column A1 in .sheets ("Results") in the master workbook where the button will be to launch the code?

    I must say that I found your site and explanation very informational. I've struggled for ages trying to get my head around looping in VBA, but almost understand it now!!

    Thanks I advance
    Frankie

  2. The examples is great, but in my case, i have a similar macro that periodically collect specific data from several files in a folder. After some time my consolidated file has hundreds on rows and the update of the file takes more time and most of the information collected is the same i had before. How can i modify the macro to collect information only from the modified files?

    Thanks

Leave a Reply

Your email address will not be published. Required fields are marked *

Terms and Conditions of use

The applications/code on this site are distributed as is and without warranties or liability. In no event shall the owner of the copyrights, or the authors of the applications/code be liable for any loss of profit, any problems or any damage resulting from the use or evaluation of the applications/code.

Visit Us On TwitterVisit Us On FacebookVisit Us On Google PlusVisit Us On Youtube