collating worksheets to master page

Need help with coding to Collating worksheets  from 1 workbook into a Master file that will have table formatting. I have 9 worksheets with identical table formatting going from column a:k, would like to be able to run a macro which will pull all the data to a master sheet with the table formatting on it as well to be able to quickly run sort quires from.
Jennifer KoopsTechnical Case managerAsked:
Who is Participating?
 
Mike in ITConnect With a Mentor IT System AdministratorCommented:
I believe Roy Cox has the solution to the mistake in my code.
You should be able to just remove the "Workbook." part of that line and it will work.
0
 
Roy CoxGroup Finance ManagerCommented:
Are you copy 9 worksheets from 1 workbook to a master workbook?

When you refer to a table format do you mean the data is formatted as a Table from the Styles Group of the Home Tab in the Ribbon?
0
 
Mike in ITIT System AdministratorCommented:
This will probably get you started, might be perfect depending on what your exact files look like.
This is assuming a few things based on your description:
  • All the sheets are in the same workbook
  • You will always have the same headers
  • You have created a sheet named "Master" in the same workbook (no need for another workbook if all the data is already in this one)

Sub CollateSheets()
    Dim LastRow
    Dim wbMain As Workbook
    Dim wsMaster As Worksheet
    Dim MasterLastRow
    Set wbMain = ThisWorkbook
    Set wsMaster = wbMain.Sheets("Master")
    
    For x = 1 To ThisWorkbook.Sheets.Count Step 1
        If Workbook.Sheets(x).Name <> "Master" Then
            LastRow = Workbook.Sheets(x).Cells(Workbook.Sheets(x).Rows.Count, 1).End(xlUp).Row  'Gets last row for each sheet
            Workbook.Sheets(x).Range("A2:K" & LastRow).Copy                                     'Copies all data from A:K to the last row
            MasterLastRow = wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row                'Gets current last row on the Master sheet
            Workbook.Sheets("Master").Range("A" & MasterLastRow + 1).PasteSpecial               'Pastes the data from each sheet on the next row
        End If
    Next x
    MasterLastRow = wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row                            'Gets current last row on the Master sheet
    wsMaster.ListObjects.Add(xlSrcExternal, Range("A1:K" & MasterLastRow), , xlYes).Name = "Data"   'Sets the table style on the data that has been copied
    wsMaster.ListObjects("Data").TableStyle = "TableStyleLight9"                                    'Sets the table style to light 9
End Sub

Open in new window

0
Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

 
Jennifer KoopsTechnical Case managerAuthor Commented:
So what I am trying to create is a running call log, each of the 9 agents needs to have either there own workbook or worksheet (doesn't matter what ever is easiest) that they fill in specific fields (A:K) , all exactly the same layout as each other.  All of this information then needs to be (if possible) auto combined into a master log which our supervisors will need to be able to sort and filter for particular details.   The information on the master list needs to also be cumulative but not duplicate data.  


Right now  I have tabs for each agent that when a macro is run will file into a master sheet but the master sheet deletes and rebuilds every time the macro is run and I feel like when we get into  each agent having 1000's of entry's  that process will bog down and or break. it also makes it so I can not format the master list into any sort of table unless I do it manually each time the macro runs.


When I say table I mean  the Insert tab - tables ribbon - table option

this is the info im using right now to accomplish this but I don't feel like its going to accomplish what I want in the long run
Sub CopyRangeFromMultiWorksheets()
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim CopyRng As Range

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Delete the sheet "Master" if it exist
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("Master").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    'Add a worksheet with the name "Master"
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "Master"

    'loop through all worksheets and copy the data to the DestSh
    For Each sh In ActiveWorkbook.Worksheets

        'Loop through all worksheets except the Master worksheet and the
        'Information worksheet, you can ad more sheets to the array if you want.


            'Find the last row with data on the DestSh
            Last = LastRow(DestSh)

            'Fill in the range that you want to copy
            Set CopyRng = sh.Range("A2:K2")

            'Test if there enough rows in the DestSh to copy all the data
            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                MsgBox "There are not enough rows in the Destsh"
                GoTo ExitTheSub
            End If

            'This example copies values/formats, if you only want to copy the
            'values or want to copy everything look at the example below this macro
            CopyRng.Copy
            With DestSh.Cells(Last + 1, "A")
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With


       Next

ExitTheSub:

    Application.GoTo DestSh.Cells(1)

    'AutoFit the column width in the DestSh sheet

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Open in new window


I have slightly modified this code so I know there are parts that are no longer functioning but I cant seem to clean them up  without breaking things.
0
 
Jennifer KoopsTechnical Case managerAuthor Commented:

Mike in IT

•All the sheets are in the same workbook
•You will always have the same headers
•You have created a sheet named "Master" in the same workbook (no need for another workbook if all the data is already in this one)
 

all of this is true and I am running into error on  

10: If Workbook.Sheets(x).Name <> "Master" Then
0
 
Roy CoxGroup Finance ManagerCommented:
Try this, it might need amending but just let me know
Option Explicit



'---------------------------------------------------------------------------------------
' Module    : Data
' Author    : Roy Cox (royUK)
' Website   : for more examples and Excel Consulting
' Date      : 19/11/2011
' Purpose   : Combine data from several worksheet
' Disclaimer: Disclaimer; This code is offered as is with no guarantees. You may use it in your
'             projects but please leave this header intact.

'---------------------------------------------------------------------------------------



Sub CombineData()
    Dim oWs As Worksheet
    Dim rRng As Range, rToCopy As Range, rNextCl As Range
    Dim lCount As Long

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
        '   On Error GoTo exithandler

        With ThisWorkbook.Worksheets("Master")
            For Each oWs In ThisWorkbook.Worksheets
                If oWs.Name <> "Master" Then
                    Set rToCopy = oWs.Range("A1").CurrentRegion
                    Set rNextCl = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
                    ''///don't copy headers
                    Set rToCopy = rToCopy.Offset(1, 0).Resize(rToCopy.Rows.Count - 1, _
                                                              rToCopy.Columns.Count)
                End If
                rToCopy.Copy rNextCl
            Next oWs
        End With

exithandler:
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
End Sub

Open in new window

0
 
Roy CoxConnect With a Mentor Group Finance ManagerCommented:
If Workbook.Sheets(x).Name <> "Master" Then

Open in new window

should be

If  Sheets(x).Name <> "Master" Then

Open in new window

0
 
Roy CoxGroup Finance ManagerCommented:
Some feedback from Jennifer would be appreciated.
0
 
Roy CoxGroup Finance ManagerCommented:
Mike, I've just further checked your code and it will not work because you haven't provided the Function to find the Last Row
0
 
Mike in ITIT System AdministratorCommented:
Roy, there is no function the Last Row is found using this:
LastRow = Workbook.Sheets(x).Cells(Workbook.Sheets(x).Rows.Count, 1).End(xlUp).Row

Open in new window

This is on line 11 of the code I provided.
0
 
Roy CoxGroup Finance ManagerCommented:
This is expecting a Function

'Find the last row with data on the DestSh
            Last = LastRow(DestSh)

Open in new window

0
 
Mike in ITIT System AdministratorCommented:
That is line 31 in Jennifer's code. I did not write that. But you are definitely right that won't work without the accompanying function that it is trying to call.
0
 
Roy CoxGroup Finance ManagerCommented:
Sorry Mike. I thought that was taken from your code.
0
 
Mike in ITIT System AdministratorCommented:
Roy - No worries, I can see where the confusion comes in there, they do look similar.

Jennifer - Glad we were able to help you.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.