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:
- Download the MergerExcel.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).
- Open the MergerExcel.xlsm.
- Provide the Folder path in the “Sheet1”.
- Click the “Merge” Button.
Download Link: MergeExcel
Thanks Kumar for suggesting this article.
Complete Code:
[sourcecode language=”VB”]
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
[/sourcecode]