protegeone
11-06-2005, 01:28 PM
Hi,
Stumbled on a new problem ( might be trivial to some ):
Want to copy sheet to new workbook, with some additional cells to be locked.
Sheet is protected, so only unlocked cells to be selected.
When running below code, sheet copied fine, but unfortunately when opening new workbook - even though sheet is protected and most cells locked - able to select any cells, even the ones locked and the ones to be locked prior to copy stayed unlocked.
If unprotecting sheet and then protecting it, the dialog box shows that
"allow selection" choices have both locked and unlocked checked, when only
unlocked should have been.
Sub CopySheet()
Dim SaveAsName As String
Application.ScreenUpdating = False
SaveAsName = Range("A8").Text
If SaveAsName = "" Then
MsgBox " Name field empty "
MsgBox "Add name and try again"
GoTo ExitHandler
End If
ChDir "C:\Downloads"
Application.DisplayAlerts = False
ActiveSheet.Copy
ActiveSheet.Shapes("Button 1").Select
Selection.Delete
ActiveSheet.Shapes("Button 5").Select
Selection.Delete
Range("A8:E11").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
Range("F8:H11").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
Range("I8:K11").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
Range("A8:E11,F8:H11,I8:K11").Select
With Selection.Locked = True
Selection.FormulaHidden = False
End With
ActiveSheet.EnableSelection = xlUnlockedCells
ActiveSheet.Protect UserInterfaceOnly:=True
ActiveWorkbook.SaveAs SaveAsName
ActiveWindow.Close
Range("M3:N5,M6:N7,M8:N9,M10:N11,F15:H16,F17:H18," & _
"F19:H20,F21:H22,F23:H24,F25:H26,I25:K26,I23:K24," & _
"I21:K22,I19:K20,I17:K18,I15:K16,L15:N16,L17:N18," _
"L19:N20,L21:N22,L23:N24,L25:N26").Select
With Selection.ClearContents
End With
Range("P16").Select
Application.ScreenUpdating = True
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
Application.ScreenUpdating = True
End Sub
Would someone please have a look and point out my mistakes.
Thanks
Protege
Stumbled on a new problem ( might be trivial to some ):
Want to copy sheet to new workbook, with some additional cells to be locked.
Sheet is protected, so only unlocked cells to be selected.
When running below code, sheet copied fine, but unfortunately when opening new workbook - even though sheet is protected and most cells locked - able to select any cells, even the ones locked and the ones to be locked prior to copy stayed unlocked.
If unprotecting sheet and then protecting it, the dialog box shows that
"allow selection" choices have both locked and unlocked checked, when only
unlocked should have been.
Sub CopySheet()
Dim SaveAsName As String
Application.ScreenUpdating = False
SaveAsName = Range("A8").Text
If SaveAsName = "" Then
MsgBox " Name field empty "
MsgBox "Add name and try again"
GoTo ExitHandler
End If
ChDir "C:\Downloads"
Application.DisplayAlerts = False
ActiveSheet.Copy
ActiveSheet.Shapes("Button 1").Select
Selection.Delete
ActiveSheet.Shapes("Button 5").Select
Selection.Delete
Range("A8:E11").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
Range("F8:H11").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
Range("I8:K11").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
Range("A8:E11,F8:H11,I8:K11").Select
With Selection.Locked = True
Selection.FormulaHidden = False
End With
ActiveSheet.EnableSelection = xlUnlockedCells
ActiveSheet.Protect UserInterfaceOnly:=True
ActiveWorkbook.SaveAs SaveAsName
ActiveWindow.Close
Range("M3:N5,M6:N7,M8:N9,M10:N11,F15:H16,F17:H18," & _
"F19:H20,F21:H22,F23:H24,F25:H26,I25:K26,I23:K24," & _
"I21:K22,I19:K20,I17:K18,I15:K16,L15:N16,L17:N18," _
"L19:N20,L21:N22,L23:N24,L25:N26").Select
With Selection.ClearContents
End With
Range("P16").Select
Application.ScreenUpdating = True
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
Application.ScreenUpdating = True
End Sub
Would someone please have a look and point out my mistakes.
Thanks
Protege