Be the first user to complete this post

  • 0
Add to List

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.

Modified Consolidator
Modified Consolidator

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

intFilesCounter = 1
For Each fls In listfiles
If intFilesCounter = 1 Then
mainworkbook.Sheets("Combine").Range("A" & rowCounter).Select
Application.Workbooks.Open (Folderpath & "\" & fls.Name)
Set tempworkbook = ActiveWorkbook
Set newfile = ActiveSheet
For x = mainworkbook.Sheets("Combine").Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
If WorksheetFunction.CountA(mainworkbook.Sheets("Combine").Rows(x)) = 0 Then
End If
rowCounter = mainworkbook.Sheets("Combine").UsedRange.Rows.Count + 1
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
intR = rowCounter
End If
intFilesCounter = intFilesCounter + 1
rowCounter = mainworkbook.Sheets("Combine").UsedRange.Rows.Count + 1
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
findTheColumnNo = intIndex
End Function

Also Read:

  1. VBA Excel – Looping Through a Range of Cells
  2. VBA Excel - Cells, Ranges and Offset : Offset
  3. VBA-Excel: Writing Text to Word document
  4. Getting Started with Excel Macro
  5. VBA-Excel: Create a new Word Document