Copy sheet problem with protection

[protegeone]

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

[Amanda1]

Hi Protege,

I've only been a member for two days and new to the VBA side - but I had a similair problem on some sheets that I was working on a little while ago. The only way I could get round it was to put in my script to unprotect the sheet at the beginning and then when it was finished to reprotect and simulatenously protect new sheet if you need to.

I don't know if this will help you, or I might be misunderstanding what you mean.

Take care
Amanda. Oops, another thing that gave me some odd results occasionally was if the sheet was protected but not the workbook and vice versa - could be worth a look.

[Cass]

I thin you must first unprotect sheet

Sheets("sheet name").Unprotect ("password_here")

and finally protect again

Sheets("sheet name").Protect ("password_here")