Be the first user to complete this post
|Add to List|
VBA-Excel: Consolidator – Merge or Combine Multiple Excel Files Into One
Download Link : Consolidator_1.0
If you want to combine many excel files into one file and you don’t want to do it manually, you have come to the right place. This piece of software will allow you merge as many excel files you want, say 500-1000 excel files. This tool will provide you various options of formatting before you merge your files.
How to Use it:
- Download the consolidator.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).
3. Open the Consolidator.xlsm.
4. Go to the sheet 2(“Change Path and header settings”). In this sheet you have options to-
- “Remove blank rows” if available in any of this files while combining.
- “Remove repeated headers” if available in any of this files while combining.
- Provide the folder path where you all excel files are stored.
5. Once done with setting , you click the “Click to combine files” either from sheet 1(“List of Files“) or Sheet 2 (“Change Path and header settings”)
6. That’s it, your all the files from the specified folder will be combined into one and gets stored in to Sheet 3(“Combine”). At the end you will get a message box stating how many files are combined and name of all the files combined in sheet 1.
7. Output with
- Remove blank rows – False
- Remove repeated headers – False
8. Output with
- Remove blank rows – True
- Remove repeated headers – True
Sub sumit() Dim fso As New FileSystemObject 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 rowcounter As Double 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 Folderpath = ActiveWorkbook.Sheets(2).Range("I7").Value headerset = ActiveWorkbook.Sheets(2).Range("F4").Value Delete_Remove_Blank_Rows = ActiveWorkbook.Sheets(2).Range("F3").Value 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 counter = 0 r_counter = 1 rowcounter = 1 Actualrowcount = 0 For Each fls In listfiles counter = counter + 1 Range("A" & counter).Value = fls.Name Next 'MsgBox ("count of files in folder is " & NoOfFiles) Set mainworkbook = ActiveWorkbook Set combinedworksheet = mainworkbook.Sheets(2) mainworkbook.Sheets(3).UsedRange.Clear 'MsgBox ("Sheet is clear for the data to be copied") For i = 1 To NoOfFiles mainworkbook.Sheets("Combine").Activate 'MsgBox ("Sheet 3 is Activated") mainworkbook.Sheets("Combine").Range("A" & rowcounter).Select Application.Workbooks.Open (Folderpath & "\" & Range("A" & i).Value) Set tempworkbook = ActiveWorkbook Set newfile = ActiveSheet rowpasted = rowcounter 'MsgBox ("pointer at " & rowpasted) newfile.UsedRange.Copy 'MsgBox ("Data is copied") mainworkbook.Sheets(3).Paste 'MsgBox ("Data is pasted successfully") 'MsgBox ("Blank rows has been deleted " & Remove_Blank_Rows & " " & headerset) If Delete_Remove_Blank_Rows = "Yes" Then 'If Remove_Blank_Rows = Yes Then 'MsgBox ("Blank rows has been deleted" & Delete_Remove_Blank_Rows) 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 'MsgBox ("Blank rows has been deleted" & Remove_Blank_Rows) End If Next End If rowcounter = mainworkbook.Sheets(3).UsedRange.Rows.Count + 1 'MsgBox ("row counter is updated" & rowcounter) rowpasted = rowcounter - rowpasted 'MsgBox ("No fo rows pasted" & rowpasted) delHeaderRow = rowcounter - rowpasted 'MsgBox ("Which row to delete" & delHeaderRow) 'MsgBox ("Pointer at row beforw deletion" & rowpasted) If headerset = "Yes" Or headerset = "YES" Or headerset = "yes" Then If delHeaderRow <> 1 Then mainworkbook.Sheets(3).Rows(delHeaderRow).EntireRow.Delete rowcounter = rowcounter - 1 rowpasted = rowpasted - 1 Else End If Else End If 'MsgBox ("Header deleted") 'MsgBox ("row counter is updated" & rowcounter) combinedworksheet.UsedRange.ClearOutline 'combinedworksheet. tempworkbook.Close 'MsgBox ("no of rows are abt to get pasted in sheet 1") Files_Count_No_Of_Rows_In_Sheets(i) = rowpasted Actualrowcount = Actualrowcount + rowpasted Next i mainworkbook.Sheets(1).UsedRange.ClearContents For Each fls In listfiles r_counter = r_counter + 1 mainworkbook.Sheets(1).Range("A" & r_counter).Value = fls.Name mainworkbook.Sheets(1).Range("B" & r_counter).Value = Files_Count_No_Of_Rows_In_Sheets(r_counter - 1) mainworkbook.Sheets(1).Range("A" & r_counter, "B" & r_counter).Borders.Value = 1 Next mainworkbook.Sheets(1).Range("B" & r_counter + 1).Interior.ColorIndex = 46 mainworkbook.Sheets(1).Range("B" & r_counter + 1).Value = Actualrowcount mainworkbook.Sheets(1).Range("B" & r_counter + 1).Borders.Value = 1 mainworkbook.Sheets(1).Range("A1", "B1").Interior.ColorIndex = 46 mainworkbook.Sheets(1).Range("A1", "B1").Borders.Value = 1 mainworkbook.Sheets(1).Range("A1").Value = "Files List" mainworkbook.Sheets(1).Range("B1").Value = "No Of Rows" MsgBox ("List of Files are Availabe in sheet 1..Total " & NoOfFiles & " Files Combiled") End Sub
Download Link : Consolidator_1.0
- Excel-VBA : Insert Multiple Images from a Folder to Excel Cells
- VBA-Excel: Working with Bookmarks- Insert text before Bookmark
- VBA-Excel: Appending Text to an Existing Word Document - at the End
- VBA-Excel: Delete Blank Rows from Excel Work Sheet
- VBA-Excel: Create worksheets with Names in Specific Format/Pattern.
- VBA-Excel: Format already written text in a word document – Format Paragraphs
- Getting Started with Excel Macro
- Send Mail With Link to a Workbook, From MS Outlook using Excel.