Guys,
I am not a very experienced VBa programmer, but I have written some VBa to take a master workbook & create a number of separate workbooks by selecting a drop-down in the master to populate each slave. The issue I'm having is that I want to protect some cells (those not in yellow) in each sheet of the slave workbooks. I believe the code in place is doing this (for page 1 currently), but the problem I'm having is that because the workbook is now protected, it doesn't allow me to use saveas
How do I get around this?
Code below
Thanks
Lee
Sub splitter()
'
' This macro replicates a given worksheet for all retailers.
' Macro created 1/30/2013 by Lee
' Keyboard Shortcut: Ctrl+Shift+S
'
' Define the key variables
'
Dim RtlCount As Integer
' This variable records the number of retailers
'
Dim Data(350) As String
' This variable stores the retailer code
'
Dim RetailName(350) As String
' This array presumes there are not more than 350 retailers (also see Do Loop below)
' This variable stores the code and name of each retailer
'
Dim RtlMarket(350) As String
' Stores the Market for each retailer
'
Dim RtlRegion(350) As String
' Stores the Market for each retailer
'
Dim RetailerFilename As String
' This variable defines the output workbook filename
'
Dim astrLinks As Variant
Dim i As Integer
Dim Cell
' For removing the links
'
' Step 1: Get name of reference worksheet defining how many retailers (workbooks)
'
Msg = "Please Confirm or Correct Retailer Profile Worksheet Name"
DirName = InputBox(Msg, , "FS Data")
If DirName = "" Then Exit Sub
Sheets(DirName).Select
'
' Step 2: Get the reference data (presumes it starts on row 5, loops until it hits NORTHEAST)
'
Country = "NORTHEAST"
RtlCount = 0
Range("A5").Select
ActiveCell.Offset(0, 0).Range("A1").Select
Do While Country <> ActiveCell
RtlCount = RtlCount + 1
ActiveCell.Offset(0, 0).Range("A1").Select
Data(RtlCount) = ActiveCell
If Data(RtlCount) = "" Then Exit Sub
ActiveCell.Offset(0, 1).Range("A1").Select
RetailName(RtlCount) = ActiveCell
ActiveCell.Offset(0, 2).Range("A1").Select
RtlRegion(RtlCount) = ActiveCell
ActiveCell.Offset(0, 83).Range("A1").Select
RtlMarket(RtlCount) = ActiveCell
ActiveCell.Offset(1, -86).Range("A1").Select
Loop
'
' Step 3: Get name of worksheet to be replicated
'
Msg = "Please Confirm or Correct Business Planning Tool Page 1 Worksheet Name"
BPToolName1 = InputBox(Msg, , "Profitability")
If BPToolName1 = "" Then Exit Sub
'
Msg = "Please Confirm or Correct Business Planning Tool Page 2 Worksheet Name"
BPToolName2 = InputBox(Msg, , "New")
If BPToolName2 = "" Then Exit Sub
'
Msg = "Please Confirm or Correct Business Planning Tool Page 3 Worksheet Name"
BPToolName3 = InputBox(Msg, , "Parts & Service")
If BPToolName3 = "" Then Exit Sub
'
Msg = "Please Confirm or Correct Business Planning Tool Page 4 Worksheet Name"
BPToolName4 = InputBox(Msg, , "BD Monthly Tracking")
If BPToolName4 = "" Then Exit Sub
'
Msg = "Please Confirm or Correct Business Planning Tool Page 5 Worksheet Name"
BPToolName5 = InputBox(Msg, , "BD Close Rates")
If BPToolName5 = "" Then Exit Sub
'
Msg = "Please Confirm or Correct Business Planning Tool Page 6 Worksheet Name"
BPToolName6 = InputBox(Msg, , "Bonus Opp")
If BPToolName6 = "" Then Exit Sub
'
Msg = "Please Confirm or Correct Business Planning Tool Page 7 Worksheet Name"
BPToolName7 = InputBox(Msg, , "Other")
If BPToolName7 = "" Then Exit Sub
'
Msg = "Please Confirm or Correct Business Planning Tool Page 8 Worksheet Name"
BPToolName8 = InputBox(Msg, , "Action Plans")
If BPToolName8 = "" Then Exit Sub
'
' Step 4 : Check if the copied worksheets formulas should be converted into values
'
Msg = "Do you want the copied worksheet formulas converted to values?"
Config = vbYesNo + vbQuestion + vbDefaultButton1
ConvertQ = MsgBox(Msg, Config)
If ConvertQ = vbYes Then
Sheets(BPToolName1).Select
ActiveSheet.Unprotect
Sheets(BPToolName2).Select
ActiveSheet.Unprotect
Sheets(BPToolName3).Select
ActiveSheet.Unprotect
Sheets(BPToolName4).Select
ActiveSheet.Unprotect
Sheets(BPToolName5).Select
ActiveSheet.Unprotect
Sheets(BPToolName6).Select
ActiveSheet.Unprotect
Sheets(BPToolName7).Select
ActiveSheet.Unprotect
Sheets(BPToolName8).Select
ActiveSheet.Unprotect
Sheets(BPToolName1).Select
End If
'
' Step 5: Replicate as required
'
RemDefault = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Application.DisplayAlerts = False
RemMacro = ActiveWorkbook.Name
For Retailers = 1 To RtlCount
Workbooks.Add
NewBookName = ActiveWorkbook.Name
Retailer_Filename = RtlRegion(Retailers) & "_Mkt" & RtlMarket(Retailers) & "_" & Data(Retailers)
For Num = 1 To 8
'
' Page 1
'
Windows(RemMacro).Activate
Sheets(Array(BPToolName1, BPToolName2, BPToolName3, BPToolName4, BPToolName5, BPToolName6, BPToolName7, BPToolName8)).Select
Sheets(Array(BPToolName1, BPToolName2, BPToolName3, BPToolName4, BPToolName5, BPToolName6, BPToolName7, BPToolName8)).Copy After:=Workbooks(NewBookName).Sheets(Num)
NewSheetName = ActiveSheet.Name
Range("D5").Value = Data(Retailers)
Sheets(NewSheetName).Name = BPToolName1 + " " + Data(Retailers)
If ConvertQ = vbYes Then
Cells.Select
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("D5").Select
End If
For Each Cell In ActiveSheet.UsedRange
Select Case True
Case Cell.Interior.ColorIndex = 6
Cell.Locked = False
Case Else
Cell.Locked = True
End Select
Next
ActiveSheet.Protect userinterfaceonly:=True
' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
'
' Page 2
'
Num = Num + 1
Sheets(BPToolName2).Select
Sheets(BPToolName2).Name = BPToolName2 + " " + Data(Retailers)
If ConvertQ = vbYes Then
Cells.Select
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("C3").Select
End If
' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
'
' Page 3
'
Num = Num + 1
Sheets(BPToolName3).Select
Sheets(BPToolName3).Name = BPToolName3 + " " + Data(Retailers)
If ConvertQ = vbYes Then
Cells.Select
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
' Range("C3").Select
Range("C2").Select
End If
' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
'
' Page 4
'
Num = Num + 1
Sheets(BPToolName4).Select
Sheets(BPToolName4).Name = BPToolName4 + " " + Data(Retailers)
If ConvertQ = vbYes Then
Cells.Select
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("A2").Select
End If
' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
'
' Page 5
'
Num = Num + 1
Sheets(BPToolName5).Select
Sheets(BPToolName5).Name = BPToolName5 + " " + Data(Retailers)
If ConvertQ = vbYes Then
Cells.Select
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("B1").Select
End If
' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
'
' Page 6
'
Num = Num + 1
Sheets(BPToolName6).Select
Sheets(BPToolName6).Name = BPToolName6 + " " + Data(Retailers)
If ConvertQ = vbYes Then
Cells.Select
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("D2").Select
End If
' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
'
' Page 7
'
Num = Num + 1
Sheets(BPToolName7).Select
Sheets(BPToolName7).Name = BPToolName7 + " " + Data(Retailers)
If ConvertQ = vbYes Then
Cells.Select
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("C2").Select
End If
' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
'
' Page 8
'
Num = Num + 1
Sheets(BPToolName8).Select
Sheets(BPToolName8).Name = BPToolName8 + " " + Data(Retailers)
If ConvertQ = vbYes Then
Cells.Select
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("C2").Select
End If
' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Next Num
'
' Delete erroneous sheet1 from the workbook
'
Application.DisplayAlerts = False
Sheets("Sheet1").Select
ActiveWindow.SelectedSheets.Delete
' Define variable as an Excel link type.
astrLinks = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
' Break the links in the active workbook.
For i = LBound(astrLinks) To UBound(astrLinks)
ActiveWorkbook.BreakLink _
Name:=astrLinks(i), _
Type:=xlLinkTypeExcelLinks
Next i
'
' Save the Workbook & Close it
'
ActiveWorkbook.SaveAs Filename:="E:\Volvo Individual Retailer Business Plans\" & Retailer_Filename & ".xls", FileFormat:= _
xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveWorkbook.Close savechanges:=True
Next Retailers
If ConvertQ = vbYes Then
Windows(RemMacro).Activate
Sheets(BPToolName1).Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets(BPToolName2).Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets(BPToolName3).Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets(BPToolName4).Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets(BPToolName5).Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets(BPToolName6).Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets(BPToolName7).Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets(BPToolName8).Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
Application.DisplayAlerts = True
Application.SheetsInNewWorkbook = RemDefault
End Sub
I am not a very experienced VBa programmer, but I have written some VBa to take a master workbook & create a number of separate workbooks by selecting a drop-down in the master to populate each slave. The issue I'm having is that I want to protect some cells (those not in yellow) in each sheet of the slave workbooks. I believe the code in place is doing this (for page 1 currently), but the problem I'm having is that because the workbook is now protected, it doesn't allow me to use saveas
How do I get around this?Code below
Thanks
Lee
Sub splitter()
'
' This macro replicates a given worksheet for all retailers.
' Macro created 1/30/2013 by Lee
' Keyboard Shortcut: Ctrl+Shift+S
'
' Define the key variables
'
Dim RtlCount As Integer
' This variable records the number of retailers
'
Dim Data(350) As String
' This variable stores the retailer code
'
Dim RetailName(350) As String
' This array presumes there are not more than 350 retailers (also see Do Loop below)
' This variable stores the code and name of each retailer
'
Dim RtlMarket(350) As String
' Stores the Market for each retailer
'
Dim RtlRegion(350) As String
' Stores the Market for each retailer
'
Dim RetailerFilename As String
' This variable defines the output workbook filename
'
Dim astrLinks As Variant
Dim i As Integer
Dim Cell
' For removing the links
'
' Step 1: Get name of reference worksheet defining how many retailers (workbooks)
'
Msg = "Please Confirm or Correct Retailer Profile Worksheet Name"
DirName = InputBox(Msg, , "FS Data")
If DirName = "" Then Exit Sub
Sheets(DirName).Select
'
' Step 2: Get the reference data (presumes it starts on row 5, loops until it hits NORTHEAST)
'
Country = "NORTHEAST"
RtlCount = 0
Range("A5").Select
ActiveCell.Offset(0, 0).Range("A1").Select
Do While Country <> ActiveCell
RtlCount = RtlCount + 1
ActiveCell.Offset(0, 0).Range("A1").Select
Data(RtlCount) = ActiveCell
If Data(RtlCount) = "" Then Exit Sub
ActiveCell.Offset(0, 1).Range("A1").Select
RetailName(RtlCount) = ActiveCell
ActiveCell.Offset(0, 2).Range("A1").Select
RtlRegion(RtlCount) = ActiveCell
ActiveCell.Offset(0, 83).Range("A1").Select
RtlMarket(RtlCount) = ActiveCell
ActiveCell.Offset(1, -86).Range("A1").Select
Loop
'
' Step 3: Get name of worksheet to be replicated
'
Msg = "Please Confirm or Correct Business Planning Tool Page 1 Worksheet Name"
BPToolName1 = InputBox(Msg, , "Profitability")
If BPToolName1 = "" Then Exit Sub
'
Msg = "Please Confirm or Correct Business Planning Tool Page 2 Worksheet Name"
BPToolName2 = InputBox(Msg, , "New")
If BPToolName2 = "" Then Exit Sub
'
Msg = "Please Confirm or Correct Business Planning Tool Page 3 Worksheet Name"
BPToolName3 = InputBox(Msg, , "Parts & Service")
If BPToolName3 = "" Then Exit Sub
'
Msg = "Please Confirm or Correct Business Planning Tool Page 4 Worksheet Name"
BPToolName4 = InputBox(Msg, , "BD Monthly Tracking")
If BPToolName4 = "" Then Exit Sub
'
Msg = "Please Confirm or Correct Business Planning Tool Page 5 Worksheet Name"
BPToolName5 = InputBox(Msg, , "BD Close Rates")
If BPToolName5 = "" Then Exit Sub
'
Msg = "Please Confirm or Correct Business Planning Tool Page 6 Worksheet Name"
BPToolName6 = InputBox(Msg, , "Bonus Opp")
If BPToolName6 = "" Then Exit Sub
'
Msg = "Please Confirm or Correct Business Planning Tool Page 7 Worksheet Name"
BPToolName7 = InputBox(Msg, , "Other")
If BPToolName7 = "" Then Exit Sub
'
Msg = "Please Confirm or Correct Business Planning Tool Page 8 Worksheet Name"
BPToolName8 = InputBox(Msg, , "Action Plans")
If BPToolName8 = "" Then Exit Sub
'
' Step 4 : Check if the copied worksheets formulas should be converted into values
'
Msg = "Do you want the copied worksheet formulas converted to values?"
Config = vbYesNo + vbQuestion + vbDefaultButton1
ConvertQ = MsgBox(Msg, Config)
If ConvertQ = vbYes Then
Sheets(BPToolName1).Select
ActiveSheet.Unprotect
Sheets(BPToolName2).Select
ActiveSheet.Unprotect
Sheets(BPToolName3).Select
ActiveSheet.Unprotect
Sheets(BPToolName4).Select
ActiveSheet.Unprotect
Sheets(BPToolName5).Select
ActiveSheet.Unprotect
Sheets(BPToolName6).Select
ActiveSheet.Unprotect
Sheets(BPToolName7).Select
ActiveSheet.Unprotect
Sheets(BPToolName8).Select
ActiveSheet.Unprotect
Sheets(BPToolName1).Select
End If
'
' Step 5: Replicate as required
'
RemDefault = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Application.DisplayAlerts = False
RemMacro = ActiveWorkbook.Name
For Retailers = 1 To RtlCount
Workbooks.Add
NewBookName = ActiveWorkbook.Name
Retailer_Filename = RtlRegion(Retailers) & "_Mkt" & RtlMarket(Retailers) & "_" & Data(Retailers)
For Num = 1 To 8
'
' Page 1
'
Windows(RemMacro).Activate
Sheets(Array(BPToolName1, BPToolName2, BPToolName3, BPToolName4, BPToolName5, BPToolName6, BPToolName7, BPToolName8)).Select
Sheets(Array(BPToolName1, BPToolName2, BPToolName3, BPToolName4, BPToolName5, BPToolName6, BPToolName7, BPToolName8)).Copy After:=Workbooks(NewBookName).Sheets(Num)
NewSheetName = ActiveSheet.Name
Range("D5").Value = Data(Retailers)
Sheets(NewSheetName).Name = BPToolName1 + " " + Data(Retailers)
If ConvertQ = vbYes Then
Cells.Select
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("D5").Select
End If
For Each Cell In ActiveSheet.UsedRange
Select Case True
Case Cell.Interior.ColorIndex = 6
Cell.Locked = False
Case Else
Cell.Locked = True
End Select
Next
ActiveSheet.Protect userinterfaceonly:=True
' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
'
' Page 2
'
Num = Num + 1
Sheets(BPToolName2).Select
Sheets(BPToolName2).Name = BPToolName2 + " " + Data(Retailers)
If ConvertQ = vbYes Then
Cells.Select
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("C3").Select
End If
' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
'
' Page 3
'
Num = Num + 1
Sheets(BPToolName3).Select
Sheets(BPToolName3).Name = BPToolName3 + " " + Data(Retailers)
If ConvertQ = vbYes Then
Cells.Select
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
' Range("C3").Select
Range("C2").Select
End If
' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
'
' Page 4
'
Num = Num + 1
Sheets(BPToolName4).Select
Sheets(BPToolName4).Name = BPToolName4 + " " + Data(Retailers)
If ConvertQ = vbYes Then
Cells.Select
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("A2").Select
End If
' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
'
' Page 5
'
Num = Num + 1
Sheets(BPToolName5).Select
Sheets(BPToolName5).Name = BPToolName5 + " " + Data(Retailers)
If ConvertQ = vbYes Then
Cells.Select
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("B1").Select
End If
' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
'
' Page 6
'
Num = Num + 1
Sheets(BPToolName6).Select
Sheets(BPToolName6).Name = BPToolName6 + " " + Data(Retailers)
If ConvertQ = vbYes Then
Cells.Select
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("D2").Select
End If
' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
'
' Page 7
'
Num = Num + 1
Sheets(BPToolName7).Select
Sheets(BPToolName7).Name = BPToolName7 + " " + Data(Retailers)
If ConvertQ = vbYes Then
Cells.Select
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("C2").Select
End If
' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
'
' Page 8
'
Num = Num + 1
Sheets(BPToolName8).Select
Sheets(BPToolName8).Name = BPToolName8 + " " + Data(Retailers)
If ConvertQ = vbYes Then
Cells.Select
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("C2").Select
End If
' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Next Num
'
' Delete erroneous sheet1 from the workbook
'
Application.DisplayAlerts = False
Sheets("Sheet1").Select
ActiveWindow.SelectedSheets.Delete
' Define variable as an Excel link type.
astrLinks = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
' Break the links in the active workbook.
For i = LBound(astrLinks) To UBound(astrLinks)
ActiveWorkbook.BreakLink _
Name:=astrLinks(i), _
Type:=xlLinkTypeExcelLinks
Next i
'
' Save the Workbook & Close it
'
ActiveWorkbook.SaveAs Filename:="E:\Volvo Individual Retailer Business Plans\" & Retailer_Filename & ".xls", FileFormat:= _
xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveWorkbook.Close savechanges:=True
Next Retailers
If ConvertQ = vbYes Then
Windows(RemMacro).Activate
Sheets(BPToolName1).Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets(BPToolName2).Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets(BPToolName3).Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets(BPToolName4).Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets(BPToolName5).Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets(BPToolName6).Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets(BPToolName7).Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets(BPToolName8).Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
Application.DisplayAlerts = True
Application.SheetsInNewWorkbook = RemDefault
End Sub
