Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!
Excel Combine Multiple worksheets into one
I am having trouble combining 200+ worksheets into one sheet. I have attached a sample file to show the data, and what it should look like. There is a sheet called Template to show what every sheet looks like, they are all in the same format, but not every information is filled. I added two sample data sheets called, '3M ESPE Retraction Capsule' and 'Acupeds'. The sheet called 'Final' shows what it should look like after those two sheets are combined into 'Final'. I need some help for combining multiple sheets (200+ sheets). Is there a macro to do this so I don't have to do it manually?
Book1.xlsm
Book1.xlsm
Do more with
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
I personally don't think you can find a better and easier solution other than free Addin by Ron , you can download from here http://www.rondebruin.nl/win/addins/rdbmerge.htm
If this does not help you then you can come back and we will try to help you
If this does not help you then you can come back and we will try to help you
I dont think this will work, as the my original templates' headers are not in columns, and I want to put this in columns as well.
Hi Bob,
I have edited Ron de Bruin's code as per your requirement:
I tested on your sample workbook and its copying all the data from every sheet to Consolidate sheet. Sorry to say Formatting cannot be pasted as it differs from every sheet to your final sheet.
You need to create separate code for formatting...
Open attached and run macro CombineSheets
Bob_Combine-Multiple-Sheet-To-One_v.xlsm
I have edited Ron de Bruin's code as per your requirement:
Sub CombineSheets()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
With Application
.ScreenUpdating = False
.DisplayStatusBar = True
.StatusBar = "!!! Please Be Patient...Updating Records !!!"
.EnableEvents = False
.Calculation = xlManual
End With
'Delete the sheet "Consolidate" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("Consolidate").Delete
On Error GoTo 0
Application.DisplayAlerts = True
'Add a worksheet with the name "Consolidate"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "Consolidate"
'Set Up Headers
DestSh.Cells(1, 4).Value = "Date Submitted/Requested"
DestSh.Cells(1, 5).Value = "CR#"
DestSh.Cells(1, 6).Value = "Submitted/Requested by"
DestSh.Cells(1, 7).Value = "Issue"
DestSh.Cells(1, 10).Value = "Generic Name"
DestSh.Cells(1, 11).Value = "CAS #"
DestSh.Cells(1, 12).Value = "Trade Name(s)"
DestSh.Cells(1, 13).Value = "Product Description"
DestSh.Cells(1, 16).Value = "Active Ingredient(s)"
DestSh.Cells(1, 18).Value = "Non-medicinal Ingredient(s)/excipient(s)"
DestSh.Cells(1, 19).Value = "Specific Indication(s)"
DestSh.Cells(1, 22).Value = "Marketed For/ Intended Use"
DestSh.Cells(1, 25).Value = "Instructions for Use"
DestSh.Cells(1, 28).Value = "Combination Product?"
DestSh.Cells(1, 29).Value = "Combination Product Components"
DestSh.Cells(1, 31).Value = "Principal Mechanism of Action"
DestSh.Cells(1, 34).Value = "Current Market Status"
DestSh.Cells(1, 35).Value = "Classification Outside of Canada"
DestSh.Cells(1, 36).Value = "Similar Product(s)"
DestSh.Cells(1, 37).Value = "Manufacturer"
DestSh.Cells(1, 38).Value = "Sponsor"
DestSh.Cells(1, 39).Value = "Sponsor's Contact information"
DestSh.Cells(1, 40).Value = "Sponsor's Proposal and Rationale"
DestSh.Cells(1, 43).Value = "Similar Past Decision(s)/precedent(s)"
DestSh.Cells(1, 46).Value = "Legal Opinion(s)"
DestSh.Cells(1, 49).Value = "Others Consulted"
DestSh.Cells(1, 52).Value = "Research & Analysis"
DestSh.Cells(1, 55).Value = "OoS Recommendation(s)"
DestSh.Cells(1, 58).Value = "TPCC Recommendation(s)"
DestSh.Cells(1, 61).Value = "Other Recommendation(s)"
DestSh.Cells(1, 64).Value = "CPC Recommendation(s)"
DestSh.Cells(1, 67).Value = "Impact of Decision(s)"
DestSh.Cells(1, 70).Value = "Comments"
DestSh.Cells(1, 73).Value = "Pending Action(s)"
DestSh.Cells(1, 76).Value = "Completed Action(s)"
'loop through all worksheets and copy the data to the DestSh
For Each sh In ActiveWorkbook.Worksheets
If IsError(Application.Match(sh.Name, Array(DestSh.Name, "Final", "Template"), 0)) Then
'Find the last Column with data on the DestSh
Last = LastRow(DestSh)
sh.Range("B7").Copy
DestSh.Cells(Last + 1, "D").PasteSpecial xlPasteValues 'Date Submitted/Requested
sh.Range("C7").Copy
DestSh.Cells(Last + 1, "E").PasteSpecial xlPasteValues 'CR#
sh.Range("D7").Copy
DestSh.Cells(Last + 1, "F").PasteSpecial xlPasteValues 'Submitted/Requested by
sh.Range("B10").Copy
DestSh.Cells(Last + 1, "G").PasteSpecial xlPasteValues 'Issue
sh.Range("B14").Copy
DestSh.Cells(Last + 1, "J").PasteSpecial xlPasteValues 'Generic Name
sh.Range("C14").Copy
DestSh.Cells(Last + 1, "K").PasteSpecial xlPasteValues 'CAS #
sh.Range("D14").Copy
DestSh.Cells(Last + 1, "L").PasteSpecial xlPasteValues 'Trade Name(s)
sh.Range("B17").Copy
DestSh.Cells(Last + 1, "M").PasteSpecial xlPasteValues 'Product Description
sh.Range("B20").Copy
DestSh.Cells(Last + 1, "P").PasteSpecial xlPasteValues 'Active Ingredient(s)
sh.Range("D20").Copy
DestSh.Cells(Last + 1, "R").PasteSpecial xlPasteValues 'Non-medicinal Ingredient(s)/excipient(s)
sh.Range("B23").Copy
DestSh.Cells(Last + 1, "S").PasteSpecial xlPasteValues 'Specific Indication(s)
sh.Range("B26").Copy
DestSh.Cells(Last + 1, "V").PasteSpecial xlPasteValues 'Marketed For/ Intended Use
sh.Range("B29").Copy
DestSh.Cells(Last + 1, "Y").PasteSpecial xlPasteValues 'Instructions for Use
sh.Range("B32").Copy
DestSh.Cells(Last + 1, "AB").PasteSpecial xlPasteValues 'Combination Product?
sh.Range("C32").Copy
DestSh.Cells(Last + 1, "AC").PasteSpecial xlPasteValues 'Combination Product Components
sh.Range("B32").Copy
DestSh.Cells(Last + 1, "AE").PasteSpecial xlPasteValues 'Principal Mechanism of Action
sh.Range("B38").Copy
DestSh.Cells(Last + 1, "AH").PasteSpecial xlPasteValues 'Current Market Status
sh.Range("C38").Copy
DestSh.Cells(Last + 1, "AI").PasteSpecial xlPasteValues 'Classification Outside of Canada
sh.Range("D38").Copy
DestSh.Cells(Last + 1, "AJ").PasteSpecial xlPasteValues 'Similar Product(s)
sh.Range("B42").Copy
DestSh.Cells(Last + 1, "AK").PasteSpecial xlPasteValues 'Manufacturer
sh.Range("C42").Copy
DestSh.Cells(Last + 1, "AL").PasteSpecial xlPasteValues 'Sponsor
sh.Range("D42").Copy
DestSh.Cells(Last + 1, "AM").PasteSpecial xlPasteValues 'Sponsor's Contact information
sh.Range("B42").Copy
DestSh.Cells(Last + 1, "AO").PasteSpecial xlPasteValues 'Sponsor's Proposal and Rationale
sh.Range("B50").Copy
DestSh.Cells(Last + 1, "AQ").PasteSpecial xlPasteValues 'Similar Past Decision(s)/precedent(s)
sh.Range("B53").Copy
DestSh.Cells(Last + 1, "AT").PasteSpecial xlPasteValues 'Legal Opinion(s)
sh.Range("B56").Copy
DestSh.Cells(Last + 1, "AW").PasteSpecial xlPasteValues 'Others Consulted
sh.Range("B59").Copy
DestSh.Cells(Last + 1, "AZ").PasteSpecial xlPasteValues 'Research & Analysis
sh.Range("B62").Copy
DestSh.Cells(Last + 1, "BC").PasteSpecial xlPasteValues 'OoS Recommendation(s)
sh.Range("B65").Copy
DestSh.Cells(Last + 1, "BF").PasteSpecial xlPasteValues 'TPCC Recommendation(s)
sh.Range("B68").Copy
DestSh.Cells(Last + 1, "BI").PasteSpecial xlPasteValues 'Other Recommendation(s)
sh.Range("B71").Copy
DestSh.Cells(Last + 1, "BL").PasteSpecial xlPasteValues 'CPC Recommendation(s)
sh.Range("B74").Copy
DestSh.Cells(Last + 1, "BO").PasteSpecial xlPasteValues 'Impact of Decision(s)
sh.Range("B78").Copy
DestSh.Cells(Last + 1, "BR").PasteSpecial xlPasteValues 'Comments
sh.Range("B81").Copy
DestSh.Cells(Last + 1, "BU").PasteSpecial xlPasteValues 'Pending Action(s)
sh.Range("B84").Copy
DestSh.Cells(Last + 1, "BX").PasteSpecial xlPasteValues 'Completed Action(s)
Application.CutCopyMode = False
'Optional: This will copy the sheet name in the H column
DestSh.Cells(Last + 1, "A").Value = sh.Name
End If
Next
ExitTheSub:
Application.Goto DestSh.Cells(1)
'AutoFit the column width in the DestSh sheet
DestSh.Columns.AutoFit
With Application
.ScreenUpdating = True
.DisplayStatusBar = True
.StatusBar = False
.EnableEvents = True
.Calculation = xlAutomatic
End With
End Sub
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("D1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Function LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
After:=sh.Range("D1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function
I tested on your sample workbook and its copying all the data from every sheet to Consolidate sheet. Sorry to say Formatting cannot be pasted as it differs from every sheet to your final sheet.
You need to create separate code for formatting...
Open attached and run macro CombineSheets
Bob_Combine-Multiple-Sheet-To-One_v.xlsm
Premium Content
You need an Expert Office subscription to comment.Start Free Trial