Improving ‘Worksheet_Activate’ macro

Improving ‘Worksheet_Activate’ macro

The following macro is used to merge multiple worksheets in the same ‘Master’ sheet.

Current process:
-      A ‘Master’ worksheet is created manually in an existing ‘Data’ workbook with multiple worksheets.
-      Macro ‘Worksheet_Activate’ is run with ‘Master’ worksheet active.
-      The result: the content of all worksheets is gathered in ‘Master’ worksheet.
-      Each month, some or all worksheets of the ‘Data’ workbook are updated individually.
-      Again, Macro ‘Worksheet_Activate’ is run with ‘Master’ worksheet active.

Result: the content of all worksheets is gathered in ‘Master’ worksheet. Former content is automatically replaced  in ‘Master’ worksheet.

 I would like to be able to:
-      Choose which worksheets need to be copied.
The choice  could be set directly in the code or via some buttons to be clicked not in the different worksheets of the workbook.

(e.g.: worksheet1 ; Worksheet2; Worksheet6  selected but not Worksheet4 and Worksheet7)

-      Keep original cells format.
Currently the formatting of the cells is lost in the ‘Master’ worksheet after the macro is run:; Date, percentage, etc.

------------------------------------------------------------------------------------------------------
  Macro
------------------------------------------------------------------------------------------------------
Sub Worksheet_Activate()

  Dim ws As Worksheet
  Dim r As Long
 
  'Turn screen updates off to make things look nicer
  Application.ScreenUpdating = False
 
  'Delete everything in Master sheet, from row 2 downwards
  ActiveSheet.UsedRange.Offset(1).Clear
 
  'Loop through all worksheets
  For Each ws In ActiveWorkbook.Worksheets
    'Do this for all sheets except the Master sheet
    If ws.Name <> ActiveSheet.Name Then
      'Copy from 2nd row and downwards
      ws.UsedRange.Offset(1, 0).Copy
      'Paste values to Master sheet, below last used row
      Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1).PasteSpecial xlPasteValues
    End If
  Next ws
 
  'Remove completely empty rows
  For r = ActiveSheet.UsedRange.Rows.Count To 2 Step -1
    If Application.WorksheetFunction.CountA(Rows(r)) = 0 Then
      Rows(r).Delete
    End If
  Next r
 
  'Select cell A1
  Range("A1").Select
 
  'Turn after-copy-blinking off
  Application.CutCopyMode = False
 
  'Turn screen updates back on
  Application.ScreenUpdating = True
End Sub

------------------------------------------------------------------------------------------------------

Thanks in advance for the time you take to review this question.

Bye
fredericgilbertAsked:
Who is Participating?
 
Hernan_CanoConnect With a Mentor Commented:
A simple way to define which sheets are to be copied is:

 
(...)
If ws.Name <> ActiveSheet.Name _
and ws.Name = "[WorkSheet Name]" _
and ws.Name = "Sheet 2" _
and ws.Name = "Some other WS name" Then
(...)

Open in new window

0
 
Hernan_CanoCommented:
Sorry, that should be "or" instead of "and". A worksheet can't have ALL values. It must be "one of those" names.
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.