Show Buttons
Share On Facebook
Share On Twitter
Share On Google Plus
Share On Linkdin
Share On Reddit
Contact us
Hide Buttons

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

Down­load Link: Merge­Ex­cel

This is the exten­sion of my ear­lier arti­cle “Con­sol­ida­tor”.

In this arti­cle we will mod­ify it fur­ther. Sup­pose we have a sce­nario where we have mul­ti­ple excel files with same columns but they are not in the same order. See the exam­ple below.

Modified Consolidator

Mod­i­fied 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. Pro­vide the Folder path in the “Sheet1”.
  5. Click the “Merge” Button.

MergerExcel

Down­load Link: Merge­Ex­cel

Thanks Kumar for sug­gest­ing this article.

Com­plete 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

You may also like...

6 Responses

  1. marll says:

    Hi SJ, this is nice tool.
    Btw, how about split/create new work­book based on col­umn value?
    any VBA on this?

  2. Santosh Bhagwan Jawalkar says:

    HI SJ,

    Below error cant find project or labrary

    Dim list­files As Files

  3. Coco says:

    Hi SJ,

    You always make cool VBA projects.

    Btw, how about if all work­books have mul­ti­ple sheets and you only need to get the data on the sec­ond sheet?

    • SJ says:

      Then you need to spec­ify the sheet from which you want to get the data. mainWorkBook.Sheets(“yoursheetname”), some­thing like this or if is fixed that its always the sheet no 2 then you can spec­ify the sheet num­ber as well.

Leave a Reply

Your email address will not be published. Required fields are marked *

%d bloggers like this: