Copy A Worksheet And Reassign Copied Macro Button Actions
In a recently completed workbook application, the main worksheet contains 2 buttons which trigger macros to sort the data. Each button sorts the data in a different sequence as fast as the user can click. As a project requirement I duplicated this worksheet 4 times, and in each of the copies use a different model to look at the data. When a worksheet is copied, all the buttons, pictures, and other objects of that worksheet are copied also. Even the macros assigned to the buttons stay the same... which is not desirable for this application. Let's say that I'm looking at Sheet1, and the sort buttons reference Sheet1. The copies also contain the buttons, but instead of referencing the new sheet, they still reference Sheet1. So if I'm on Sheet3, instead of sorting the data in Sheet3, it still sorts the data in Sheet1. This has to be changed!!
The purpose of the code snippet below is to show how to copy a sheet and reassign the button actions to the current sheet. Keep in mind that Excel sometimes changes the names of the buttons when they are copied, so you have to "discover" the new names and use those names to reference the button in the code.
The code snippets below illustrate:
(1) How to copy a complete worksheet (including buttons) to a new worksheet
(2) How to discover the copied button names
(3) How to reassign the macro action to the new buttons
Program Code
**** NOTE --- These are not complete programs --- They are snippets to illustrate the topic.
' **************************************************************
' Create New Worksheets By Copying An Entire Worksheet
' Then Rename the Worksheet
' **************************************************************
Set rngTemp = Range(shtInWarehouse.Cells(3, 26), shtInWarehouse.Cells(intNumberOfRowsInUpdatedInWarehouse, 26))
strLastDivision = shtInWarehouse.Cells(3, 26).Value
For Each C In rngTemp
If C.Value <> strLastDivision Then
Call GetDivisionName
If strDivisionName <> "NotFound" Then
shtInWarehouse.Copy Before:=shtDivisions
ActiveSheet.Name = strDivisionName
Sheets(strDivisionName).Cells(1, 26).Value = strLastDivision
intNewSheetNamesCount = intNewSheetNamesCount + 1
strNewSheetNames(intNewSheetNamesCount) = strDivisionName
End If
strLastDivision = C.Value
End If
Next C
' **************************************************************
' Copy Last Division
' **************************************************************
Call GetDivisionName
If strDivisionName <> "NotFound" Then
shtInWarehouse.Copy Before:=shtDivisions
ActiveSheet.Name = strDivisionName
Sheets(strDivisionName).Cells(1, 26).Value = strLastDivision
intNewSheetNamesCount = intNewSheetNamesCount + 1
strNewSheetNames(intNewSheetNamesCount) = strDivisionName
End If
' **************************************************************
' Assign Macros to the Buttons
' **************************************************************
intButtonCounter = 0
For Each Shape In ActiveSheet.Shapes
If Left(Shape.Name, 6) = "Button" Then
intButtonCounter = intButtonCounter + 1
Select Case intButtonCounter
Case 1
strButtonName1 = Shape.Name
Case 2
strButtonName2 = Shape.Name
Case Is > 2
End Select
End If
Next Shape
ActiveSheet.Shapes(strButtonName1).OnAction = "SortDivisionByLastDateSold"
ActiveSheet.Shapes(strButtonName2).OnAction = "SortDivisionByHighestNetInvenUnits"