Refreshing a master sheet ?

devilxvergil

New Member
Joined
Dec 4, 2016
Messages
1
Hi all, still new to excel so pardon my newb questions.

Have copied this code from somewhere that generates a Master sheet from consolidating data from the other worksheets. However it requires me to delete away the Master sheet before generating a new Master sheet. Is there any ways to refresh the master sheet if it already exist, if not then creating a new consolidated master sheet.

Here's the code-------

TIA
<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">Sub CopyFromWorksheets()
Dim wrk As Workbook 'Workbook object - Always good to work with object variables
Dim sht As Worksheet 'Object for handling worksheets in loop
Dim trg As Worksheet 'Master Worksheet
Dim rng As Range 'Range object
Dim colCount As Integer 'Column count in tables in the worksheets
Dim tbl As ListObject

Set wrk = ActiveWorkbook 'Working in active workbook
ActiveSheet.Move after:=Worksheets(Worksheets.Count)

For Each sht In wrk.Worksheets
If sht.Name = "Master" Then
MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _
"Please remove or rename this worksheet since 'Master' would be" & _
"the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error"
Exit Sub
End If
Next sht

'We don't want screen updating
Application.ScreenUpdating = False

'Add new worksheet as the last worksheet
Set trg = wrk.Worksheets.Add(after:=wrk.Worksheets(wrk.Worksheets.Count))
'Rename the new worksheet
trg.Name = "Master"
'Get column headers from the first worksheet
'Column count first
Set sht = wrk.Worksheets(1)
colCount = sht.Cells(3, 255).End(xlToLeft).Column
'Now retrieve headers, no copy&paste needed
With trg.Cells(1, 1).Resize(1, colCount)
.Value = sht.Cells(3, 1).Resize(1, colCount).Value
'Set font as bold
.Font.Bold = True
End With

'We can start loop
For Each sht In wrk.Worksheets
'If worksheet in loop is the last one, stop execution (it is Master worksheet)
If sht.Index = wrk.Worksheets.Count Then
Exit For
End If
If sht.Name <> "Main" Then
'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
Set rng = sht.Range(sht.Cells(4, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))
'Put data into the Master worksheet
trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
End If
Next sht
'Fit the columns in Master worksheet
trg.Columns.AutoFit

Set rng = Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))
Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, rng, , xlYes)
tbl.TableStyle = "TableStyleMedium15"


'Screen updating should be activated
Application.ScreenUpdating = True
End Sub</code>
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Hi,
welcome to forum,

see if this update to your code does what you want:

Code:
Sub CopyFromWorksheets()
    Dim wrk As Workbook 'Workbook object - Always good to work with object variables
    Dim sht As Worksheet 'Object for handling worksheets in loop
    Dim trg As Worksheet 'Master Worksheet
    Dim rng As Range 'Range object
    Dim colCount As Integer 'Column count in tables in the worksheets
    Dim tbl As ListObject
    
    Set wrk = ActiveWorkbook 'Working in active workbook


'We don't want screen updating
    Application.ScreenUpdating = False
    
    On Error Resume Next
    Set trg = wrk.Worksheets("Master")
    If trg Is Nothing Then
'Add new worksheet as the last worksheet
        Set trg = wrk.Worksheets.Add(after:=wrk.Worksheets(wrk.Worksheets.Count))
'Rename the new worksheet
        trg.Name = "Master"
        Err.Clear
    Else
'clear existing records
        trg.UsedRange.Clear
    End If
    On Error GoTo exitsub


'Get column headers from the first worksheet
'Column count first
    Set sht = wrk.Worksheets(1)
    colCount = sht.Cells(3, sht.Columns.Count).End(xlToLeft).Column
'Now retrieve headers, no copy&paste needed
    With trg.Cells(1, 1).Resize(1, colCount)
        .Value = sht.Cells(3, 1).Resize(1, colCount).Value
'Set font as bold
        .Font.Bold = True
    End With
    
'We can start loop
    For Each sht In wrk.Worksheets
'If worksheet in loop is the last one, stop execution (it is Master worksheet)
        If sht.Index = wrk.Worksheets.Count Then
            Exit For
        End If
        If sht.Name <> "Main" Then
'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
            Set rng = sht.Range(sht.Cells(4, 1), sht.Cells(sht.Rows.Count, 1).End(xlUp).Resize(, colCount))
'Put data into the Master worksheet
            trg.Cells(trg.Rows.Count, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
        End If
        Next sht
'Fit the columns in Master worksheet
        trg.Columns.AutoFit
        
        Set rng = Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))
        Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, rng, , xlYes)
        tbl.TableStyle = "TableStyleMedium15"
        
exitsub:
'Screen updating should be activated
    Application.ScreenUpdating = True
    If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Dave
 
Upvote 0

Forum statistics

Threads
1,214,642
Messages
6,120,698
Members
448,979
Latest member
DET4492

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