Be the first user to complete this post
|
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.
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:
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:
- Excel-VBA : Send a Excel Workbook as Attachment in Mail From MS Outlook Using Excel
- Getting Started with Excel Macro
- VBA Excel - Cells, Ranges and Offset: Refer to Cells by Using Shortcut Notation
- VBA-Excel: Select and Activate Cells - Select
- VBA-Excel: Create worksheets with Names in Specific Format/Pattern.