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
Bob TianAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Professor JMicrosoft Excel ExpertCommented:
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
Bob TianAuthor Commented:
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.
Bob TianAuthor Commented:
Still looking for some help on this
Price Your IT Services for Profit

Managed service contracts are great - when they're making you money. Yes, you’re getting paid monthly, but is it actually profitable? Learn to calculate your hourly overhead burden so you can master your IT services pricing strategy.

Download eBook
ShumsExcel & VBA ExpertCommented:
Hi Bob,

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

Open in new window


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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Bob TianAuthor Commented:
Thanks for that, it worked! I was busy with something else so I didn't have time to test it immediately
ShumsExcel & VBA ExpertCommented:
You're Welcome Bob! Glad I was able to help.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.