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.
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.
Once you have opened the editor, then click on the Insert tab and pick the Module option.
A module will be created and we can write the required code in that module to execute the program.
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.
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.
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.
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.
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.
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.
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.
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.
All the filtered columns will be sorted in the given location as soon as I entered the OK button.
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.
Thus, we will have our final desired output.
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
- How to Use Excel VBA to Copy Range to Another Excel Sheet
- Macro to Copy Specific Columns from One Worksheet to Another in Excel
- Excel VBA: Copy Range to Another Workbook
- Excel VBA to Copy Data from Another Workbook without Opening
- How to Open All Excel Files in a Folder and Copy Data Using VBA