Excel VBA to Loop Through Files in Folder and Copy Data 

Get FREE Advanced Excel Exercises with Solutions!

It is not a very uncommon phenomenon that we need to make a compilation of multiple Excel files into a single one. For this, we need to go through each specific sheet of those files, copy the required data, and extract them into a new sheet or file. In this article, I will try to explain 4 simple ways on the topic of how to use Excel VBA to Loop Through Files in Folder and Copy Data. Let’s dive into the details.

Excel vba loop through files in folder and copy data


How to Launch VBA Editor in Excel

We often create a module in order to work with VBA. First of all, we need to go to the Developer tab and select Visual Basic to create a module.

Opening a Visual Basic Editor

Once you have opened the editor, then click on the Insert tab and pick the Module option.

Creating a Module

A module will be created and we can write the required code in that module to execute the program.

Space to write the VBA Code


Excel VBA to Loop Through Files in Folder and Copy Data: 4 Examples

To make a compilation of multiple Excel files, we first need to loop through each file in the folder, copy the required data, and locate it in a definite place like horizontally or vertically in a sheet or a master file as multiple sheets. Here is the image of the files that I will try to copy data from throughout the article.

Excel Files to Loop Through in folder and copy data


1. Loop Through Files in Folder and Copy Data in One Sheet Horizontally

In order to loop through files in a folder and copy data in a specific sheet horizontally, we can use the Dir function. The Dir function returns the file name that matches the given pathname. It will help us to loop through similar types of files among multiple files in a folder. Then, with the help of the following VBA code which comprises Copy and Paste, we can copy the data and place them horizontally in one sheet.

Code to Loop Through Files in Folder and Copy Data in One Sheet Horizontally

Sub Loop_Through_Files_in_Folder_and_Copy_Data()
'Disable unnecessary factors
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Define the common sheet name in all files and output location
Sheet_Name = "Sheet1"
Set New_Workbook = ThisWorkbook
'Pick the folder containing Excel files
Set File_Dialog = Application.FileDialog(msoFileDialogFolderPicker)
File_Dialog.AllowMultiSelect = False
File_Dialog.Title = "Select the Excel Files"
If File_Dialog.Show <> -1 Then
    Exit Sub
End If
'Define the file types to loop through
File_Path = File_Dialog.SelectedItems(1) & "\"
File_Name = Dir(File_Path & "*.xls*")
'Iterate Through a Loop to Open All the Files and Copy Data from Them
ActiveColumn = 1
Do While File_Name <> ""
    Set file = Workbooks.Open(fileName:=File_Path & File_Name)
    file.Worksheets(Sheet_Name).UsedRange.Copy
    ActiveColumn = ActiveColumn + 1
    New_Workbook.Worksheets(Sheet_Name).Cells(1, ActiveColumn).PasteSpecial Paste:=xlPasteAll
    ActiveColumn = ActiveColumn + file.Worksheets(1).UsedRange.Columns.Count
    File_Name = Dir()
Loop
End Sub

Code Breakdown

Under the Loop_Through_Files_in_Folder_and_Copy_Data sub procedure, I have disabled the factors at first that may create problems with the perfect execution of our code.

Then, I defined the sheet name that I want to copy and the current workbook as the output location.

With the Application.FileDialog(msoFileDialogFolderPicker) command, I will have the window to select the folder.

I have copied and pasted the desired range with a Do While Loop and got the copied value horizontally in a single sheet.

Output of Horizontally Aligned Copied Files

Read More: How to Open Another Workbook and Copy Data with Excel VBA


2. Loop Through Files to Copy Data in One Sheet Vertically

We can also loop through the files of a folder and copy data in one sheet vertically. The file opening procedure and copying data are almost similar to the previous one. Just a major change where I have used the OFFSET function to define the location vertically and paste the copied data there.

Code to Loop Through Files in the Folder and Copy Data in One Sheet Vertically

Sub Loop_Through_Files_in_Folder_and_Copy_Data()
'Disable unnecessary factors
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Define the common sheet name in all files and output location
WorkSheet_Name = "Sheet1"
Set Current_Workbook = ThisWorkbook
'Pick the folder containing Excel files
Set FD = Application.FileDialog(msoFileDialogFolderPicker)
FD.AllowMultiSelect = False
FD.Title = "Select the Excel Files"
If FD.Show <> -1 Then
    Exit Sub
End If
'Define the file types to loop through
File_Direction = FD.SelectedItems(1) & "\"
Filename = Dir(File_Direction & "*.xls*")
'Iterate Through a Loop to Open All the Files and Copy Data from Them
ActiveColumn = 1
Do While Filename <> ""
    Set file = Workbooks.Open(Filename:=File_Direction & Filename)
    file.Worksheets(WorkSheet_Name).UsedRange.Copy
    ActiveColumn = ActiveColumn + 1
    Current_Workbook.Worksheets(WorkSheet_Name).Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll
    ActiveColumn = ActiveColumn + file.Worksheets(1).UsedRange.Columns.Count
    Filename = Dir()
Loop
End Sub

Code Breakdown

Here, I will have a window to select the folder with the help of the Application.FileDialog(msoFileDialogFolderPicker) command.

After that, I have run a Do While Loop to loop through similar-type files and got the copied value vertically with OFFSET in a single sheet.

Output of Vertically Aligned Copied Files

Read More: Excel VBA to Copy Rows to Another Worksheet Based on Criteria


3. Creating Master File by Looping Through Files in Folder and Copy Data into Sheets

In the above 2 sections, I have shown the way to loop through multiple files in a folder and copied data in one sheet horizontally and vertically. We can also loop through files in a folder and compile them in a master file quite easily. In this process, I have copied the common sheet entirely from those files and created a master workbook with those sheets.

Code to Loop Through Files in Folder and Copy Data to Create Master File with those Sheets

Option Explicit
Sub Master_File_Creation()
Dim Folder_Path As String
Dim File_Name As String
Dim WBook As Workbook
Dim FinalWB  As Workbook
Dim WSheet As Worksheet
Dim New_Sheet As Worksheet
Dim Rng As Range
Dim PasteRow As Long
'Disable unnecessary factors
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set FinalWB = Workbooks("Final File.xlsm") 'Define Final Workbook
Folder_Path = "C:\Users\Dell\Desktop\Arif\VBA Related Article\Excel VBA Loop Through Files in Folder and Copy Data\"
If Right(Folder_Path, 1) <> "\" Then Folder_Path = Folder_Path & "\"
Application.ScreenUpdating = False
File_Name = Dir(Folder_Path & "*.xls*")
Do While File_Name <> ""
    Set WBook = Workbooks.Open(Folder_Path & File_Name)
    If Len(WBook.Name) > 35 Then
        MsgBox "Sheet's name can be up to 31 characters long, shorten the Excel file name"
        WBook.Close False
        GoTo Exit_Loop
    Else
        Set New_Sheet = FinalWB.Worksheets.Add(after:=FinalWB.Worksheets(1))
        New_Sheet.Name = Replace(WBook.Name, ".xlsx", "")
    End If
    For Each WSheet In WBook.Worksheets
        Set Rng = New_Sheet.Cells.Find(What:="*", Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, MatchCase:=False)
        If Not Rng Is Nothing Then
            PasteRow = Rng.Row + 1
        Else
            PasteRow = 1
        End If
        WSheet.UsedRange.Copy
        New_Sheet.Range("B" & PasteRow).PasteSpecial xlPasteValues
    Next WSheet
    WBook.Close False
Exit_Loop:
    Set WBook = Nothing
    File_Name = Dir
Loop
Application.ScreenUpdating = True
End Sub

Code Breakdown

In the Master_File_Creation sub-procedure, I have defined a specific sheet name that will loop through each of the Excel files according to the given Folder_Path and entirely copy that sheet.

Then, It will paste that copied value into a newly created worksheet with New_Sheet.Range(“B” & PasteRow).PasteSpecial xlPasteValues.

Read More: Macro to Copy and Paste from One Worksheet to Another


4. Copy Data into Master Sheet Based on Criteria

We can also copy data of specific columns from similar files in a folder. For this, I need to use the DIR function to open the file and execute a loop to copy the worksheet into a master file. I have used the following code here to execute my purpose. As it is a bit long code, I have divided it into two separate parts. They are explained briefly in the following section.

Initializing Parameters to Loop Through Files in a Folder

Execute Compilation in a Master Sheet

Option Explicit
Sub ImportExcelfiles()
    Dim File_Path As String
    Dim File_Name As String
    Dim Exchange_Rate_Date As String
    Dim Starting_Date As String, Last_Date As String
    Dim WB As Workbook
    Dim WS As Worksheet
    Dim Target_Sheet As Worksheet
    Dim Row_Count As Long
    Dim Column_Count As Long
    Dim Output_Row As Long
    Dim Calculation_Mehtod As XlCalculation
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        Calculation_Mehtod = .Calculation
        .Calculation = xlCalculationManual
    End With
    File_Path = "C:\Users\User\Desktop\Arif\Excel VBA Loop Through Files in Folder and Copy Data\Test"
    If Right(File_Path, 1) <> "\" Then File_Path = File_Path & "\"
   'Define the target worksheet
    Set Target_Sheet = ThisWorkbook.Worksheets("Sheet1")
   'set the initial output row
    Output_Row = 5
   'get the first file
    File_Name = Dir(File_Path & "*.xlsx")
    'Fix the date range
    Starting_Date = "01/12/2021
    Last_Date = "31/12/2021"
   'loop throught the excel files in the folder
    Do While File_Name <> ""
        If InStr(File_Name, "ExCnR_") > 0 Then
            Exchange_Rate_Date = Mid(File_Name, 7, 8)
            Exchange_Rate_Date = Right(Exchange_Rate_Date, 2) & "/" & Mid(Exchange_Rate_Date, 5, 2) & "/" & Left(Exchange_Rate_Date, 4)
            If DateValue(Exchange_Rate_Date) >= DateValue(Starting_Date) And DateValue(Exchange_Rate_Date) <= DateValue(Last_Date) Then
                Set WB = Workbooks.Open(File_Path & File_Name)
                Set WS = WB.Worksheets("Sheet1")
                'get the row and column counts
                With WS
                    Row_Count = .Cells(.rows.Count, 1).End(xlUp).Row
                    Column_Count = .Cells(1, .Columns.Count).End(xlToLeft).Column
                End With
                'copy and paste from C2
                WS.Range("C2", "E10").Copy
                Target_Sheet.Range("B" & Output_Row).PasteSpecial Paste:=xlPasteValues
                Output_Row = Output_Row + Row_Count - 1
                WB.Close SaveChanges:=False  'close the opened workbook
            End If
      End If
      File_Name = Dir()   'get the next file
      Loop
    Set WS = Nothing
    Set WB = Nothing
    Set Target_Sheet = Nothing
    MsgBox ("The compilation is complete.")
    With Application
        .Calculation = Calculation_Mehtod
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub

Code Breakdown

Here, I have defined the folder location under File_Path and specified the sheet name in Target_Sheet.

I have assigned two dates as range limits based on which I want to filter the values.

With a Do While Loop, I have looped through each of the files in that folder.

I have used conditions to copy the required columns and paste them sequentially into a file.

Finally, I have shown a MsgBox as the execution of the code is done.

When the code is run, a MsgBox will appear as the given instruction.

MsgBox Shown as the Completion to Code

All the filtered columns will be sorted in the given location as soon as I entered the OK button.

Output of the Executed Code

A problem that we might face is that the date will not be in the required format. For this, we need to change the cell format.

Go to the extension part of the Number Format option from the Home tab and select the Long Date option.

Modification of Date Column

Thus, we will have our final desired output.

 Final Output of Copying Data Based on Criteria into Master Sheet

Read More: Macro to Copy Data from One Workbook to Another Based on Criteria


Download Practice Workbook

You can download the practice workbook from here.


Conclusion

In the above article, I have tried to loop through files in a folder and copy data in a single sheet horizontally and vertically. I have even shown the copying process in a master book with conditions. Based on your requirements, you can choose your preferred method. I hope this article will be very helpful for you.


Related Articles

What is ExcelDemy?

ExcelDemy - Learn Excel & Get Excel Solutions Center provides online Excel training , Excel consultancy services , free Excel tutorials, free support , and free Excel Templates for Excel professionals and businesses. Feel free to contact us with your Excel problems.
Naimul Hasan Arif
Naimul Hasan Arif

Naimul Hasan Arif, a BUET graduate in Naval Architecture and Marine Engineering, has been contributing to the ExcelDemy project for nearly 2 years. Currently serving as an Excel and VBA Content Developer, Arif has authored over 120 articles. His expertise lies in Microsoft Office Suite, and he thrives on learning new aspects of data analysis. Arif's dedication to the ExcelDemy project is reflected in his consistent contributions and ongoing enthusiasm for expanding his knowledge in data analysis.

Designation

Excel &... Read Full Bio

We will be happy to hear your thoughts

Leave a reply

Advanced Excel Exercises with Solutions PDF

 

 

ExcelDemy
Logo