VBA-Excel: Modified Consolidator – Merge or Combine Multiple Excel Files Into One Where Columns Are Not In Order

Download Link: MergeExcel

This is the extension of my earlier article "Consolidator".

In this article we will modify it further. Suppose we have a scenario where we have multiple excel files with same columns but they are not in the same order. See the example below.

How to Use it:

1. Down­load the MergerExcel.xlsm from the link pro­vided at the top and at the bot­tom of this article.
2. Place all the excel files, which you want to com­bine, into one folder (make sure all files are closed).
3. Open the MergerExcel.xlsm.
4. Provide the Folder path in the "Sheet1".
5. Click the "Merge" Button.

Download Link: MergeExcel

Thanks Kumar for suggesting this article.

Complete Code:

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 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

Sub sumit()

Dim rowCounter As Double

Folderpath = ActiveWorkbook.Sheets("Sheet1").Range("B6").Value
Set fso = CreateObject("Scripting.FileSystemObject")

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
rowCounter = 1

Set mainworkbook = ActiveWorkbook
Set combinedworksheet = mainworkbook.Sheets("Combine")
mainworkbook.Sheets("Combine").UsedRange.Clear

intFilesCounter = 1
For Each fls In listfiles
If intFilesCounter = 1 Then
mainworkbook.Sheets("Combine").Activate
mainworkbook.Sheets("Combine").Range("A" & rowCounter).Select
Application.Workbooks.Open (Folderpath & "\" & fls.Name)
Set tempworkbook = ActiveWorkbook
Set newfile = ActiveSheet
newfile.UsedRange.Copy
mainworkbook.Sheets("Combine").Paste
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
End If
Next
rowCounter = mainworkbook.Sheets("Combine").UsedRange.Rows.Count + 1
combinedworksheet.UsedRange.ClearOutline
tempworkbook.Close
Else
Application.Workbooks.Open (Folderpath & "\" & fls.Name)
Set tempworkbook = ActiveWorkbook
Set newfile = ActiveSheet

intColumns = newfile.UsedRange.Columns.Count
intRows = newfile.UsedRange.Rows.Count

intR = rowCounter
For j = 1 To intColumns
strHeader = newfile.Cells(1, j)
intIndex = findTheColumnNo(strHeader)
For k = 2 To intRows
combinedworksheet.Cells(intR, intIndex).Value = newfile.Cells(k, j).Value
intR = intR + 1
Next
intR = rowCounter
Next
tempworkbook.Close
End If
intFilesCounter = intFilesCounter + 1
rowCounter = mainworkbook.Sheets("Combine").UsedRange.Rows.Count + 1
Next
End Sub

Function findTheColumnNo(strHeader)

intcols = combinedworksheet.UsedRange.Columns.Count
Dim intIndex
For i = 1 To intcols
If strHeader = combinedworksheet.Cells(1, i).Value Then
intIndex = i
Exit For
End If
Next
findTheColumnNo = intIndex
End Function

Also Read:

1. VBA-Excel: Appending Text to an Existing Word Document - at the End
2. VBA-Excel: Application.Wait OR Wait Method
3. VBA-Excel: Add Worksheets For All The Given Dates Except Weekends and Copy The Common Template In Each Worksheet
4. VBA-Excel: Appending Text to Existing Word Document - at Beginning
5. Add Tools to Quick Access Tool Bar(Excel Top Bar)