Automatically updating multiple sheets to a master sheet

Hi

I am trying to create a master budget sheet which gets automatically updated when data is inputted into individual project worksheets. I have found this code which is apparently meant to do it but I can't seem to adapt it to my workbook. I tried changing the ranges but it came up as an error.

Sub Summarize()
Dim ws As Worksheet
Dim lastRng As Range
Application.ScreenUpdating = False 'speed up code
ThisWorkbook.Sheets("Master List").Rows("2:65536").ClearContents 'clear
For Each ws In ThisWorkbook.Worksheets
Set lastRng = ThisWorkbook.Sheets("Master List").Range("b65536").End(xlUp).Offset(1, 0)
    Select Case ws.Name
        Case "Master List" 'exlude
        'do nothing
        Case Else
        ws.Activate
                
        'copy data from individual sheets
        Range("A5", Range("X65536").End(xlUp)).Copy lastRng
    End Select
Next
Application.CutCopyMode = False 'clear clipboard
Application.ScreenUpdating = True
Sheets("Master List").Activate
End Sub

I have attached my workbook. any help would be much appreciated

Why have several sheest. One sheet to contain all the data then ideally summarise using a PivotTable

Hi welshgirl89
the sheet name was incorrect

Sub Summarize()
Dim ws As Worksheet
Dim lastRng As Range
Application.ScreenUpdating = False 'speed up code
ThisWorkbook.Sheets("Master Budget").Rows("5:500").ClearContents 'clear
For Each ws In ThisWorkbook.Worksheets
Set lastRng = ThisWorkbook.Sheets("Master Budget").Range("a33").End(xlUp).Offset(1, 0)
    Select Case ws.Name
        Case "Master Budget" 'exlude
        'do nothing
        Case Else
        ws.Activate
       
        'copy data from individual sheets
        Range("A5", Range("h" & Range("A65536").End(xlUp).Row)).Copy lastRng
    End Select
Next
Application.CutCopyMode = False 'clear clipboard
Application.ScreenUpdating = True
Sheets("Master Budget").Activate
End Sub

welshgirl
Not sure what this means

Originally Posted by welshgirl89

Pike thanks thats great.... only one problem is that when new data is added it doesnt go to the next new line in the master sheet. the data groups together via the project group. How would i change that? Thank you so much for your help!

welshgirl89
you could try changing

Set lastRng = ThisWorkbook.Sheets("Master Budget").Range("a33").End(xlUp).Offset(1, 0)

to

Set lastRng = ThisWorkbook.Sheets("Master Budget").Range("a33").End(xlUp).Offset(2, 0)

the 2 adds another row

hi welshgirl89,
I think it does that ?

You don't need to activate the sheets. This code should copy all the data to the next empty row in the master sheet for each sheet.

Option Explicit

Sub Summarize()
Dim ws As Worksheet
Dim lastRng As Range

With Application
.ScreenUpdating = False 'speed up code
ThisWorkbook.Sheets("Master Budget").Rows("5:500").ClearContents 'clear

For Each ws In ThisWorkbook.Worksheets
Set lastRng = ThisWorkbook.Sheets("Master Budget").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    Select Case ws.Name
        Case "Master Budget" 'exlude
        'do nothing
        Case Else
        'copy data from individual sheets
        ws.Range("A5", Range("h" & Range("A65536").End(xlUp).Row)).Copy lastRng
    End Select
Next
.CutCopyMode = False 'clear clipboard
.ScreenUpdating = True
End With
End Sub

I've added error handling & turned off calculation to speed up

Option Explicit

Sub Summarize()
Dim ws As Worksheet
Dim lastRng As Range
Dim iCalc As Integer

On Error GoTo exit_proc
With Application
iCalc = Calculation
.ScreenUpdating = False 'speed up code
.Calculation = xlCalculationManual
ThisWorkbook.Sheets("Master Budget").Rows("5:500").ClearContents 'clear

For Each ws In ThisWorkbook.Worksheets
Set lastRng = ThisWorkbook.Sheets("Master Budget").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    Select Case ws.Name
        Case "Master Budget" 'exlude
        'do nothing
        Case Else
        'copy data from individual sheets
        ws.Range("A5", Range("h" & Range("A65536").End(xlUp).Row)).Copy lastRng
    End Select
Next
exit_proc:
.CutCopyMode = False 'clear clipboard
.ScreenUpdating = True
.Calculation = iCalc
End With
End Sub

Your sheets need to be identical, one had an extra row

welshgirl89
can you attach your workbook with the added row?
Because you want them group per worksheet?

Hi welshgirl89
two things
one get ride of sheet 5 which has no data and two change this line from

Set lastRng = ThisWorkbook.Sheets("Master Budget").Range("a33").End(xlUp).Offset(2, 0)

Set lastRng = ThisWorkbook.Sheets("Master Budget").Range("a33").End(xlUp).Offset(1, 0)

Ok the code you first had updates the the master ingroups of the sheets
You want to place the last entry you have made to the master last row.
or be filtered in acending order by date?

Hi welshgirl
luck it a wet long weekend
here is an idea i borrowed from Romperstomper
Place this code in the "Project A" sheet module
every time you leave the sheet it will update the "Master Budget" sheet if there have been new rows added

Option Explicit
Private m_StartRecordCount As Long
Public Property Get StartRecordCount() As Long
    StartRecordCount = m_StartRecordCount
End Property
Private Sub Worksheet_Activate()
  m_StartRecordCount = Sheets("Project A").Cells(Rows.Count, 1).End(xlUp).Row
End Sub
Private Sub Worksheet_Deactivate()
Dim ExitRecordCount As Long
Dim MasterListRow
ExitRecordCount = Sheets("Project A").Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("Master Budget")
MasterListRow = "A" & .Cells(Rows.Count, 1).End(xlUp).Row + 1
End With
If ExitRecordCount > StartRecordCount Then
Range("A" & StartRecordCount + 1 & ":H" & ExitRecordCount).Copy Sheets("Master Budget").Range(MasterListRow)
End If
End Sub

you can change and use it in sheets Project B and C ect....

This works by date entered did you try it?

woo hoo
okie dokie If you are satisfied with the solution(s) provided, please mark your thread as Solved.

How to mark a thread Solved
Go to the first post
Click edit
Click Go Advanced
Just below the word Title you will see a dropdown with the word No prefix.
Change to Solved
Click Save