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?
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.

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
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)
                DestSh.Cells(Last + 1, "D").PasteSpecial xlPasteValues 'Date Submitted/Requested
                DestSh.Cells(Last + 1, "E").PasteSpecial xlPasteValues 'CR#
                DestSh.Cells(Last + 1, "F").PasteSpecial xlPasteValues 'Submitted/Requested by
                DestSh.Cells(Last + 1, "G").PasteSpecial xlPasteValues 'Issue
                DestSh.Cells(Last + 1, "J").PasteSpecial xlPasteValues 'Generic Name
                DestSh.Cells(Last + 1, "K").PasteSpecial xlPasteValues 'CAS #
                DestSh.Cells(Last + 1, "L").PasteSpecial xlPasteValues 'Trade Name(s)
                DestSh.Cells(Last + 1, "M").PasteSpecial xlPasteValues 'Product Description
                DestSh.Cells(Last + 1, "P").PasteSpecial xlPasteValues 'Active Ingredient(s)
                DestSh.Cells(Last + 1, "R").PasteSpecial xlPasteValues 'Non-medicinal Ingredient(s)/excipient(s)
                DestSh.Cells(Last + 1, "S").PasteSpecial xlPasteValues 'Specific Indication(s)
                DestSh.Cells(Last + 1, "V").PasteSpecial xlPasteValues 'Marketed For/ Intended Use
                DestSh.Cells(Last + 1, "Y").PasteSpecial xlPasteValues 'Instructions for Use
                DestSh.Cells(Last + 1, "AB").PasteSpecial xlPasteValues 'Combination Product?
                DestSh.Cells(Last + 1, "AC").PasteSpecial xlPasteValues 'Combination Product Components
                DestSh.Cells(Last + 1, "AE").PasteSpecial xlPasteValues 'Principal Mechanism of Action
                DestSh.Cells(Last + 1, "AH").PasteSpecial xlPasteValues 'Current Market Status
                DestSh.Cells(Last + 1, "AI").PasteSpecial xlPasteValues 'Classification Outside of Canada
                DestSh.Cells(Last + 1, "AJ").PasteSpecial xlPasteValues 'Similar Product(s)
                DestSh.Cells(Last + 1, "AK").PasteSpecial xlPasteValues 'Manufacturer
                DestSh.Cells(Last + 1, "AL").PasteSpecial xlPasteValues 'Sponsor
                DestSh.Cells(Last + 1, "AM").PasteSpecial xlPasteValues 'Sponsor's Contact information
                DestSh.Cells(Last + 1, "AO").PasteSpecial xlPasteValues 'Sponsor's Proposal and Rationale
                DestSh.Cells(Last + 1, "AQ").PasteSpecial xlPasteValues 'Similar Past Decision(s)/precedent(s)
                DestSh.Cells(Last + 1, "AT").PasteSpecial xlPasteValues 'Legal Opinion(s)
                DestSh.Cells(Last + 1, "AW").PasteSpecial xlPasteValues 'Others Consulted
                DestSh.Cells(Last + 1, "AZ").PasteSpecial xlPasteValues 'Research & Analysis
                DestSh.Cells(Last + 1, "BC").PasteSpecial xlPasteValues 'OoS Recommendation(s)
                DestSh.Cells(Last + 1, "BF").PasteSpecial xlPasteValues 'TPCC Recommendation(s)
                DestSh.Cells(Last + 1, "BI").PasteSpecial xlPasteValues 'Other Recommendation(s)
                DestSh.Cells(Last + 1, "BL").PasteSpecial xlPasteValues 'CPC Recommendation(s)
                DestSh.Cells(Last + 1, "BO").PasteSpecial xlPasteValues 'Impact of Decision(s)
                DestSh.Cells(Last + 1, "BR").PasteSpecial xlPasteValues 'Comments
                DestSh.Cells(Last + 1, "BU").PasteSpecial xlPasteValues 'Pending Action(s)
                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


Application.Goto DestSh.Cells(1)

'AutoFit the column width in the DestSh sheet

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, _
    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, _
    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

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.