Using Excel VBA to Loop Through Files in a Folder and Copy Data

This is the sample dataset.

How to Launch the VBA Editor in Excel

Go to the Developer tab and select Visual Basic.

Click Insert and select Module.

A module is displayed. Enter your code in the module.

Below is the image of the files from which data will be copied

Example 1 – Loop Through Files in a Folder and Copy Data into 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

With the Loop_Through_Files_in_Folder_and_Copy_Data sub procedure, the factors that might create problems were disabled.

The sheet name to be copied and the current workbook as the output location were defined

Application.FileDialog(msoFileDialogFolderPicker) will display the window to select the folder.

The range was copied and pasted with a Do While Loop and the copied value returned horizontally in a single sheet.

Example 2 – Loop Through Files to 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

Application.FileDialog(msoFileDialogFolderPicker)displays a window to select the folder.

The Do While Loop loops through similar-type files and returns the copied value vertically in a single sheet.

Example 3 – Creating a Master File by Looping Through Files in a Folder and Copy Data into 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, a specific sheet name is defined that will loop through the Excel files according to the given Folder_Path and entirely copy the sheet.

It will paste the copied value into a new worksheet with New_Sheet.Range(“B” & PasteRow).PasteSpecial xlPasteValues.

Example 4 – Copy Data into a Master Sheet Based on Criteria

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

The folder location is defined in File_Path and the sheet name is specified in Target_Sheet.

Two dates were assigned as range limits based on which values will be filtered.

The Do While Loop loops through the files in the folder.

Conditions were used to copy the selected columns and paste them sequentially into a file.

A MsgBox is displayed when the code is run.