Be the first user to complete this post

  • 0
Add to List

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

Download Link : Consolidator_1.0

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:

  1. Download the consolidator.xlsm from the link provided at the top and at the bottom of this article.
  2. Place all the excel files, which you want to combine, into one folder (make sure all files are closed).
Excel Files
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
Files Output

7. Output with

  • Remove blank rows – False
  • Remove repeated headers – False
Output - with Repeated Header and blank Rows
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
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
'MsgBox ("count of files in folder is  " & NoOfFiles)
Set mainworkbook = ActiveWorkbook
Set combinedworksheet = mainworkbook.Sheets(2)
'MsgBox ("Sheet is clear for the data to be copied")
For i = 1 To NoOfFiles
'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)
'MsgBox ("Data is copied")
'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
'MsgBox ("Blank rows has been deleted" & Remove_Blank_Rows)
End If
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
rowcounter = rowcounter - 1
rowpasted = rowpasted - 1
End If
End If
'MsgBox ("Header deleted")
'MsgBox ("row counter is updated" & rowcounter)
'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
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

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

Also Read:

  1. VBA-Excel — AttachmentFetcher — Download all the Attachments from All the Mails of Specific Subject in Microsoft Outlook .
  2. VBA-Excel: Working with Bookmarks- Insert text After Bookmark
  3. Excel Macro - Visual Basic Editor
  4. VBA-Excel: Create Dynamic or Run-time WorkSheets using Macro.
  5. Excel-VBA : Send Mail with Embedded Image in message body From MS Outlook using Excel.