Protect Certain Cells in Excel 1

[shelby55]

Hi

I'm using Excel 2003.

I've finally mastered copying worksheets to another workbook (turns out there were hidden worksheets I didn't know about causing issues with some of the formulae). Now I want to be able to protect some cells in the copy but not others.

The code when I run a macro for this routine is as follows (
(but it's not working - I can still change contents in the cell):

Sheets("WSD").Select
    Selection.Locked = False
    Selection.FormulaHidden = False
    Range("L4:M40").Select
    Selection.Locked = True
    Selection.FormulaHidden = False

The entire code is:

Sub copyWorkbook()
Dim ws As Worksheet
Dim NewWB As Workbook

    Sheets(Array("WSA", "WSB", "WSC", "WSD", "WSE", "WSF")).Copy
    Set NewWB = ActiveWorkbook
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.CutCopyMode = False
    Sheets("WSD").Select
    Selection.Locked = False
    Selection.FormulaHidden = False
    Range("L4:M40").Select
    Selection.Locked = True
    Selection.FormulaHidden = False
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    NewWB.SaveCopyAs Filename:="E:\My Documents\MyWB_" & Format(Now(), "YYYYMMDD") & ".xls"
    ActiveWindow.Close
    Application.ScreenUpdating = True
End Sub

Also, what can I do to stop the window from allowing me to see the new workbook copying?

Thanks.

 

[SkipVought]

Hi,

'this keeps the copy from being displayed
    Application.ScreenUpdating = False 
 
   Sheets(Array("WSA", "WSB", "WSC", "WSD", "WSE", "WSF")).Copy
    Set NewWB = ActiveWorkbook
    Application.DisplayAlerts = False
    Application.CutCopyMode = False
    
    with NewWB.Sheets("WSD")
'unlock ALL cells
       With .Cells
          .Locked = False
          .FormulaHidden = False
       end with
'lock these cells
       with .Range("L4:M40")
           .Locked = True
           .FormulaHidden = False
       end with
       .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    end with
    NewWB.SaveCopyAs Filename:="E:\My Documents\MyWB_" & Format(Now(), "YYYYMMDD") & ".xls"
    ActiveWindow.Close
    Application.ScreenUpdating = True

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[shelby55]

HI

You rock Skip...works like a charm. Thanks so much!

Shelley