VBA-Excel: Consolidator – Merge or Combine Multiple Excel Files Into One

If you want to combine many excel files into one file and you don’t want to do it manually, you have come to the right place. This piece of software will allow you merge as many excel files you want, say 500-1000 excel files. This tool will provide you various options of formatting before you merge your files.

How to Use it:

Download the consolidator.xlsm from the link provided at the top and at the bottom of this article.
Place all the excel files, which you want to combine, into one folder (make sure all files are closed).

Excel Files

3. Open the Consolidator.xlsm.

4. Go to the sheet 2(“Change Path and header settings”). In this sheet you have options to-

“Remove blank rows” if available in any of this files while combining.
“Remove repeated headers” if available in any of this files while combining.
Provide the folder path where you all excel files are stored.

5. Once done with setting , you click the “Click to combine files” either from sheet 1(“List of Files“) or Sheet 2 (“Change Path and header settings”)

6. That’s it, your all the files from the specified folder will be combined into one and gets stored in to Sheet 3(“Combine”). At the end you will get a message box stating how many files are combined and name of all the files combined in sheet 1.

Files Output

7. Output with

Remove blank rows – False
Remove repeated headers – False

Merged File- with Repeated Header and blank Rows

8. Output with

Remove blank rows – True
Remove repeated headers – True

Merged File- with one Header and deleted blank Rows

Complete Code:

Sub sumit()

Dim fso As New FileSystemObject

Dim NoOfFiles As Double
Dim counter As Integer
Dim r_counter As Integer
Dim s As String
Dim listfiles As Files
Dim newfile As Worksheet
Dim mainworkbook As Workbook
Dim combinedworksheet As Worksheet
Dim tempworkbook As Workbook
Dim rowcounter As Double
Dim rowpasted As Integer
Dim delHeaderRow As Integer
Dim Folderpath As Variant
Dim headerset As Variant
Dim Actualrowcount As Double
Dim x As Long
Dim Delete_Remove_Blank_Rows As String

Folderpath = ActiveWorkbook.Sheets(2).Range("I7").Value
headerset = ActiveWorkbook.Sheets(2).Range("F4").Value
Delete_Remove_Blank_Rows = ActiveWorkbook.Sheets(2).Range("F3").Value

NoOfFiles = fso.GetFolder(Folderpath).Files.Count
Dim Files_Count_No_Of_Rows_In_Sheets(1000) As Double 'declare the array of the size of no of files in the folder

Set listfiles = fso.GetFolder(Folderpath).Files
counter = 0
r_counter = 1
rowcounter = 1
Actualrowcount = 0

For Each fls In listfiles
counter = counter + 1
Range("A" & counter).Value = fls.Name
Next
'MsgBox ("count of files in folder is  " & NoOfFiles)
Set mainworkbook = ActiveWorkbook
Set combinedworksheet = mainworkbook.Sheets(2)
mainworkbook.Sheets(3).UsedRange.Clear
'MsgBox ("Sheet is clear for the data to be copied")
For i = 1 To NoOfFiles
mainworkbook.Sheets("Combine").Activate
'MsgBox ("Sheet 3 is Activated")
mainworkbook.Sheets("Combine").Range("A" & rowcounter).Select
Application.Workbooks.Open (Folderpath & "\" & Range("A" & i).Value)
Set tempworkbook = ActiveWorkbook
Set newfile = ActiveSheet
rowpasted = rowcounter
'MsgBox ("pointer at " & rowpasted)
newfile.UsedRange.Copy
'MsgBox ("Data is copied")
mainworkbook.Sheets(3).Paste
'MsgBox ("Data is pasted successfully")
'MsgBox ("Blank rows has been deleted  " & Remove_Blank_Rows & " " & headerset)
If Delete_Remove_Blank_Rows = "Yes" Then
'If Remove_Blank_Rows = Yes Then
'MsgBox ("Blank rows has been deleted" & Delete_Remove_Blank_Rows)
For x = mainworkbook.Sheets("Combine").Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
If WorksheetFunction.CountA(mainworkbook.Sheets("Combine").Rows(x)) = 0 Then
mainworkbook.Sheets("Combine").Rows(x).Delete
'MsgBox ("Blank rows has been deleted" & Remove_Blank_Rows)
End If
Next
End If
rowcounter = mainworkbook.Sheets(3).UsedRange.Rows.Count + 1
'MsgBox ("row counter is updated" & rowcounter)
rowpasted = rowcounter - rowpasted
'MsgBox ("No fo rows pasted" & rowpasted)
delHeaderRow = rowcounter - rowpasted
'MsgBox ("Which row to delete" & delHeaderRow)
'MsgBox ("Pointer at row beforw deletion" & rowpasted)
If headerset = "Yes" Or headerset = "YES" Or headerset = "yes" Then
If delHeaderRow <> 1 Then
mainworkbook.Sheets(3).Rows(delHeaderRow).EntireRow.Delete
rowcounter = rowcounter - 1
rowpasted = rowpasted - 1
Else
End If
Else
End If
'MsgBox ("Header deleted")
'MsgBox ("row counter is updated" & rowcounter)
combinedworksheet.UsedRange.ClearOutline
'combinedworksheet.
tempworkbook.Close
'MsgBox ("no of rows are abt to get pasted in sheet 1")

Files_Count_No_Of_Rows_In_Sheets(i) = rowpasted
Actualrowcount = Actualrowcount + rowpasted
Next i
mainworkbook.Sheets(1).UsedRange.ClearContents
For Each fls In listfiles
r_counter = r_counter + 1
mainworkbook.Sheets(1).Range("A" & r_counter).Value = fls.Name
mainworkbook.Sheets(1).Range("B" & r_counter).Value = Files_Count_No_Of_Rows_In_Sheets(r_counter - 1)
mainworkbook.Sheets(1).Range("A" & r_counter, "B" & r_counter).Borders.Value = 1

Next
mainworkbook.Sheets(1).Range("B" & r_counter + 1).Interior.ColorIndex = 46
mainworkbook.Sheets(1).Range("B" & r_counter + 1).Value = Actualrowcount
mainworkbook.Sheets(1).Range("B" & r_counter + 1).Borders.Value = 1
mainworkbook.Sheets(1).Range("A1", "B1").Interior.ColorIndex = 46
mainworkbook.Sheets(1).Range("A1", "B1").Borders.Value = 1
mainworkbook.Sheets(1).Range("A1").Value = "Files List"
mainworkbook.Sheets(1).Range("B1").Value = "No Of Rows"

MsgBox ("List of Files are Availabe in sheet 1..Total " & NoOfFiles & " Files Combiled")
End Sub

Download Link : Consolidator_1.0

excel workbook 47 automate 45 tools and games 9