Business Model Renovation Macros Used

Further to my recent post this is one of the Business Model Renovation macros used in this project what I call  one of my ‘quick and dirty’ but handy and versatile macros.  It has been written this way because as I made changes to formulas in the templates I would just wanted to copy these specific rows not copy the whole lot in block form.   In some areas there was entered data in rows above and below these row changes so copying the full range of rows covering the changes would have clobbered this data.

Basically this could be used in a range of situations.  The Constants define the first and last column of the target range (Columns B and AK in this example) and VRowsSet can be loaded up with just the ad hoc rows you need copied.  What ever is between this columns and in these rows in the template worksheet gets copied to the activesheet.  Note I added a simple IF statement so I never clobbered my template worksheet Sheet13 which admittedly in hindsight looks redundant.

Sub BUSheetSetup_Step2_AdHocRows()
‘ Procedure : BUSheetSetup_Step_AdHocRows
‘ Author : John Hackwood e:[email protected]
‘ Date : 05 25 15
‘ Purpose : Procedure to copy specified ranges from template locations to rows
‘ other Business Units

Const STARTCOL As String = “B” ‘or adjust for first col of your range
Const ENDCOL As String = “AK” ‘or adjust for your end col of your range

Dim vRowsSet As Variant
Dim vRow As Variant

‘Enter Rows to be copied from/to eg 1,17,120…,180
vRowsSet = Array(77, 78, 79, 83, 90, 94, 101, 112)

If ActiveSheet.CodeName <> “Sheet13” Then ‘note Sheet13 was my template worksheet where I maintained formulas
For Each vRow In vRowsSet
Sheet13.Range(STARTCOL & vRow & “:” & ENDCOL & vRow).Copy ActiveSheet.Range(STARTCOL & vRow)
Next vRow

Else: MsgBox “You are in the template Worksheet so change to the correct Target sheet and then use this macro”

End If

End Sub


So then so you could use this macro on selected sheets as is within the VBE taking care that it will change the Activesheet, or use it within another macro sub to copy to multiple but specific sheets with the code below which uses a Case statement.


Sub ControlWhichSheets ()

Dim ws As Worksheet
For Each ws In Worksheets</em>
Select Case (ws.CodeName)

Case “Sheet14”, “Sheet15”, “Sheet16”, “Sheet17”, “Sheet18”, “Sheet19”
, “Sheet20”, “Sheet22”, “Sheet23”, “Sheet24”, “Sheet25”

Call BUSheetSetup_Step2_AdHocRows
End Sub

Hope someone finds this is as practical and useful as I did.