Combining mutiple excel files

[sharma9187]

Hi,

I have a master excel file template, I have made 3 copies of it. One file for each user. About 10 sheets are present in each file with same name, same formatting, same column names.
Each user enter their data in their respective files. I want to combine each sheet in user file to master sheet.

For ex.

I have sheet name 1

In master sheet If I run a macro, it should combine the data from Sheet named 1 from all the 3 files to master sheet named 1.

Could you please help me on this. I was in search of many places for a solution to this but no one was able to help me out. Seek your help on this.

Thanks in advance.

[CodeNinja]

Sharma9187,
Need a little more detail to help you. When you say combine, do you mean add rows to the bottom of the master sheet file, do you mean join data in same cells? How do you want it combined?

If you can provide a file with a very small example... showing what you want it to look like before and after, that would be of great help.

[sharma9187]

Hi,

Thanks for your reply. I have attached the template. 3 of the users will be entering into this template. I want to combine all the data row after row.

[PianoMan5]

Sharma -- I recently setup a macro which will combine multiple workbooks and/or multiple sheets within the same workbook...as long as the headers are the exact same (meaning there is some sort of data in cell A1).

Would that help?

[CodeNinja]

Sharma, where is the before and after look in the example you provided?

[sharma9187]

Will the results be in Multiple sheets or in one sheet?


Sharma -- I recently setup a macro which will combine multiple workbooks and/or multiple sheets within the same workbook...as long as the headers are the exact same (meaning there is some sort of data in cell A1).

Would that help?

[sharma9187]

I have attached 4 sample files. 3 files are entered by user and one master file which should look like after running the macro.( I have enetered data only in 4 sheets for sample) Thanks in advance.

Sharma, where is the before and after look in the example you provided?

[CodeNinja]

Not 100% sure this is what you want, but it should get you close... It does not account for duplicate rows, but then again you posted your sample with duplicate information, so I am assuming you don't care about that. You could add your own search for duplication. Regardless, this should be a start. Make sure you don't have other workbooks open at the same time as well, because I just merged ALL open workbooks :) Good luck.


Option Explicit
Sub test()
' This program will combine all open workbooks to this master workbook.
' code does NOT remove duplicates data.

Dim iSheets As Integer
Dim iWkbk As Integer
Dim lRow As Long

On Error Resume Next
Application.ScreenUpdating = False ' turn off screen updating to improve performance.


' loop through workbooks
For iWkbk = 1 To Workbooks.Count
If ThisWorkbook.Name <> Workbooks(iWkbk).Name Then ' only copy other workbooks
'loop through sheets
For iSheets = 1 To ThisWorkbook.Sheets.Count - 1 ' I don't think you want to duplicate the last sheet...
If iSheets = 9 Then
iSheets = 9

End If
For lRow = 1 To Workbooks(iWkbk).Sheets(iSheets).Range("A65536").End(xlUp).Row

' determine if this is a header or data... if it is data, copy row and paste
' if it is header, skip it.
' In looking at the sheets, all headers are either font color 1677215 or 6697881.
' I will use thse font colors to determine if the row is a header.
With Workbooks(iWkbk).Sheets(iSheets)
If .Cells(lRow, 1).Font.Color <> 16777215 And .Cells(lRow, 1).Font.Color <> 6697881 Then
.Range("A" & lRow).EntireRow.Copy
ThisWorkbook.Sheets(iSheets).Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial
End If
End With
Next lRow
Next iSheets
End If
Next iWkbk
End Sub

[sharma9187]

Thank you. Let me check.


Not 100% sure this is what you want, but it should get you close... It does not account for duplicate rows, but then again you posted your sample with duplicate information, so I am assuming you don't care about that. You could add your own search for duplication. Regardless, this should be a start. Make sure you don't have other workbooks open at the same time as well, because I just merged ALL open workbooks :) Good luck.


Option Explicit
Sub test()
' This program will combine all open workbooks to this master workbook.
' code does NOT remove duplicates data.

Dim iSheets As Integer
Dim iWkbk As Integer
Dim lRow As Long

On Error Resume Next
Application.ScreenUpdating = False ' turn off screen updating to improve performance.


' loop through workbooks
For iWkbk = 1 To Workbooks.Count
If ThisWorkbook.Name <> Workbooks(iWkbk).Name Then ' only copy other workbooks
'loop through sheets
For iSheets = 1 To ThisWorkbook.Sheets.Count - 1 ' I don't think you want to duplicate the last sheet...
If iSheets = 9 Then
iSheets = 9

End If
For lRow = 1 To Workbooks(iWkbk).Sheets(iSheets).Range("A65536").End(xlUp).Row

' determine if this is a header or data... if it is data, copy row and paste
' if it is header, skip it.
' In looking at the sheets, all headers are either font color 1677215 or 6697881.
' I will use thse font colors to determine if the row is a header.
With Workbooks(iWkbk).Sheets(iSheets)
If .Cells(lRow, 1).Font.Color <> 16777215 And .Cells(lRow, 1).Font.Color <> 6697881 Then
.Range("A" & lRow).EntireRow.Copy
ThisWorkbook.Sheets(iSheets).Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial
End If
End With
Next lRow
Next iSheets
End If
Next iWkbk
End Sub

[sharma9187]

No Results, No Error also. Nothing is happening after running this macro.

Please help.

Thanks

[CodeNinja]

Open all the workbooks you wish to merge. Make sure no other workbooks are open, then run the macro. Let me know if that works.

[sharma9187]

Hi,
Its not working. It has copied data only from first workbook. I belive its not accepting duplicates. Also few sheets data is not copied.
Please help.

Thanks

[CodeNinja]

I'll need to see the workbooks to step through and find out where something is going wrong.

Please post.

[sharma9187]

Hi,

In Post no 7 I have attached a sample.zip file which contains the sample file which I tested with.

Thanks

[sharma9187]

Anbody help on this post please..

Thanks

[PianoMan5]

Sharma...this is the code that I have but it's still a WIP; I want to eventually get the macro to open the first workbook/worksheet, ask where to begin copying the data (i.e. from row 2-down and have the 1st row the header) but I can't figure out yet how to do that.

How the below works though is prompt the user to provide all of the workbooks and it combines everything (with the assumption that the header ONLY is row 1 exlusive and is the same for all worksheets).

Sub Combine_Worksheets()

'This will copy data from all sheets of the selected workbooks
'To a sheet named 'Data' in the sheet in which the macro is run from

Dim pasterow As Integer
Dim LastRow As Long
Dim LastCol As Long
Dim MsgAnswer As VbMsgBoxResult
Dim mainsheetname As String
Dim HeaderRow As Integer
Dim HeaderAnswer As Range
mainsheetname = ActiveWorkbook.Name

MsgAnswer = MsgBox("Please select (highlight) ALL excel workbooks you wish to combine then click Open." _
& vbNewLine & vbNewLine & "*Ensure the headers for each workbook/worksheet is the EXACT same as " _
& "otherwise the consolidated " & "data will be skewed.", vbOKCancel, "Workbook Locator")
If MsgAnswer = vbCancel Then Exit Sub
'Message box to ensure user is aware of criteria necessary to make macro successful

filestoopen = Application.GetOpenFilename(MultiSelect:=True)
If Not IsArray(filestoopen) = True Then
MsgAnswer = MsgBox("You have not provided a workbook selection; please rerun the macro.", _
vbOKOnly + vbExclamation, "Workbook Locator -- Error!")
Exit Sub
End If
'Prompt asking for user to identify all workbooks to combine; if nothing select, message appears to rerun

If Not ActiveSheet.Name = "Data" Then ActiveSheet.Name = "Data"
Worksheets("Data").UsedRange.Delete

'open workbooks
For Each w In filestoopen

Application.DisplayAlerts = False
Workbooks.Open Filename:=w
copysheetname = ActiveWorkbook.Name

'copy and paste sheets
For Each sh In Worksheets

Application.DisplayAlerts = False
sheetnumber = sh.Index
'something = Worksheets(sheetnumber).UsedRange.Rows.Count + 1

If WorksheetFunction.CountA(Cells) > 0 Then
'Searches for the last cell with data and retreives the row and column #s
LastRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastCol = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range("A1", Cells(LastRow, LastCol)).Copy

'Worksheets(sheetnumber).UsedRange.Copy

Workbooks(mainsheetname).Activate
pasterow = Workbooks(mainsheetname).Worksheets("Data").UsedRange.Rows.Count + 1
If pasterow = 2 Then pasterow = 1
Workbooks(mainsheetname).Worksheets("Data").Range("A" & pasterow).Select
ActiveSheet.Paste
End If

Workbooks(copysheetname).Activate

Next sh
Application.DisplayAlerts = False
ActiveWorkbook.Close

Next w

Workbooks(mainsheetname).Worksheets("Data").Activate
With Range("A1:AN65000")
.Columns.AutoFit
.Rows.AutoFit
End With
With Rows("1:1")
.AutoFilter
With Range("A:A")
.AutoFilter Field:=1, Criteria1:=Range("A1").Value
Rows("3:65000").Delete
Selection.AutoFilter
End With
End With
'Filters for all headers (according to the initial header on row A) and deletes them

Range("A1").Select
End Sub

[sbglobal2012]

When you want to combine many documents into one single file and distribute it across different platforms, a format which can contain multiple documents, such as word, jpg, excel documents or ppt presentations, in a way independent from OS and applications will be needed.