Copy multiple worksheets to Master Worksheet

Jacksmith123

New Member
Joined
Jun 12, 2015
Messages
1
Hello Excel friends,

I'm new to this website, but not new to Excel. I require assistance with writing a macro that will copy data from multiple worksheets and paste the data to a master worksheet. Currently there are 3 worksheets named: Pivot 1, Pivot 2, and Master worksheet. The remaining worksheets are the ones I need to copy the data from. This workbook will grow with more worksheets being added to it on a bi-weekly basis.

Here are the steps in which the code needs to be written:

1) Data needs to be copied from a specific range in each worksheet. The worksheets are named by Date on a bi-weekly period basis i.e June 15, 2015, June 30, 2015 and so on.

2) For example, I may need to copy the data from Cells B8:AM200 in each worksheet. Although the starting cell will always be the same (that is B8) the number of rows and columns could vary as more worksheets get added to the workbook with data ranges being dynamic. The last row in each worksheet contains "total" information which does not need to be copied.

3) Before the data can be copied to the master worksheet, a formula needs to be inserted in cell A7 which will reference the sheet name. I'm wondering if it is possible to auto-fill this column (all cells below A7) to data that exists in the adjacent column. So if there are 200 rows that contain data in Column B, Column A will also auto-fill down to 200 rows.

4) Once this is done, I would like to copy the data to the master worksheet for each worksheet, keeping in mind that new worksheets will be added on a continuous basis. So if a new worksheet gets added it can easily be copied to the master worksheet without duplicating or writing over the information in the master worksheet.

Here is the code I have so far, but it is obviously not working:

Code:
Sub Copytomaster()

Dim ws  As Worksheet
Dim LR1 As Long
Dim LR2 As Long
        
Application.ScreenUpdating = False

For Each ws In ActiveWorkbook.Worksheets
 
    If ws.Name <> "Master" Or ws.Name <> "Pivot 1" Or ws.Name <> "Pivot 2" Then
  

             LR1 = Sheets("Master").Range("A" & Rows.Count).End(xlUp).Row
             LR2 = ws.Range("C" & Rows.Count).End(xlUp).Row
                         
             Range("A6").Select
             ActiveCell.FormulaR1C1 = "Payperiod"
             Range("A7").Select
             ActiveCell.FormulaR1C1 = ActiveSheet.Name
             Range("$A7:$A" & LR2).formula = ActiveSheet.Name
             Selection.Copy
             Selection.pastespecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                 :=False, Transpose:=False
             Application.CutCopyMode = False
                                                        
             ws.Range("A7:AM" & LR2).Copy Destination:=Sheets("Master").Range("A" & LR1)
             Sheets("Master").Select
             Range("A1").Select
     
    End If
    
    
Next ws

Application.ScreenUpdating = True

End Sub
 

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
I'll look into this...
Just need to analyse your code and recreate the conditions to test properly...
 
Upvote 0
Try this code....

Code:
Sub CopyToMaster()
Dim ws As Worksheet
Dim sLastDate As Date
    Application.ScreenUpdating = False
    If Sheets("Master").Range("A" & Rows.Count).End(xlUp).Value = "Payperiod" Then
        sLastDate = CDate(DateSerial(1900, 1, 1))
    Else
        sLastDate = CDate(Sheets("Master").Range("A" & Rows.Count).End(xlUp).Value)
    End If
    For Each ws In ActiveWorkbook.Worksheets
        With ws
            If .Name <> "Master" And .Name <> "Pivot 1" And .Name <> "Pivot 2" Then
                If CDate(.Name) > sLastDate Then
                    .Range(.Cells(7, "C"), .Cells(Rows.Count, "AM").End(xlUp)).Copy _
                        Destination:=Sheets("Master").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    Sheets("Master").Range("A6").CurrentRegion.Columns(1).SpecialCells(xlCellTypeBlanks).Value = .Name
                End If
            End If
        End With
    Next ws
    Application.ScreenUpdating = True
End Sub

NOTE:
This macro requires the Master sheet to already have a fixed set of column headings to reside in range A6:AN6.
The macro bases it's positions from these labels.


Excel 2012
ABCDEFGHI
1
2
3
4
5
6PayperiodHeading 1Heading 2Heading 3Heading 4Heading 5Heading 6Heading 7.
7
8
9
10
Master
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,255
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top