Why No Protection???

H E L P !!!!

I am copying sheets to another work book and setting passwor protection> Sheet Cover is ok (it is locked and password protected). However the other sheets are not. The code I am using is below:

VB Code:

Sub mnuEmail()
Dim tmp
Dim Bookname As String
Application.ScreenUpdating = False
tmp = MsgBox("Please confirm that you wish to create an email with the" & Chr(10) & "current Routecard pack as an attachment" & Chr(10) & Chr(10) & "Note that you will need to complete the recipients" & Chr(10) & "list and add any required message.", vbYesNo + vbQuestion, "Confirm Email")
If tmp = vbYes Then
    Bookname = "c:\temp\Routecard(Email).xls"
    OriginalBook = ActiveWorkbook.Name
    Workbooks.Add
    ActiveWorkbook.SaveAs FileName:=Bookname
    NewBook = ActiveWorkbook.Name
    WkShtNew = Worksheets.Count
    If Workbooks(OriginalBook).Sheets("Cover").Range("J6").Value = "One Day Practice" Then
        WkShtRequire = 2
        Call SetUpEmailBook
        wsName = "Day 1"
        x = 2
        Call CopyRouteEmail
    End If
    If Workbooks(OriginalBook).Sheets("Cover").Range("J6").Value = "Bronze Level Expedition" Then
        WkShtRequire = 3
        Call SetUpEmailBook
        wsName = "Day 1"
        x = 2
        Call CopyRouteEmail
        wsName = "Day 2"
        x = 3
        Call CopyRouteEmail
    End If
    ActiveWorkbook.SendMail "", "RouteCards"
    Workbooks(NewBook).Close False
    Kill Bookname
End If
Call ReactivateScreen
End Sub
 
Sub SetUpEmailBook()
If WkShtNew <> WkShtRequire Then
    If WkShtNew > WkShtRequire Then
        Application.DisplayAlerts = False
        Do Until WkShtNew = WkShtRequire
            Sheets(WkShtNew).Delete
            WkShtNew = WkShtNew - 1
        Loop
        Application.DisplayAlerts = True
    End If
    If WkShtNew < WkShtRequire Then
        Do Until WkShtNew = WkShtRequire
            Sheets(WkShtNew).Add
            WkShtNew = WkShtNew - 1
        Loop
    End If
End If
Workbooks(OriginalBook).Activate
Sheets("Cover").Select
Cells.Copy
Workbooks(NewBook).Activate
Sheets(1).Select
Cells.PasteSpecial xlPasteAll
Cells.Copy
Cells.PasteSpecial xlPasteValues
ActiveSheet.Name = "Cover"
Worksheets("Cover").Range("A1:R43").Locked = True
Sheets("Cover").Protect password:="ranger", DrawingObjects:=True, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True ' This part protects sheet Cover OK
End Sub
 
Sub CopyRouteEmail()
Workbooks(OriginalBook).Activate
Sheets(wsName).Select
Range("A1:R60").Select
Cells.Copy
Workbooks(NewBook).Activate
Sheets(x).Select
Cells.PasteSpecial xlPasteValues
Workbooks(OriginalBook).Activate
Sheets(wsName).Select
Range("A1:R60").Select
Cells.Copy
Workbooks(NewBook).Activate
Sheets(x).Select
Cells.PasteSpecial xlPasteFormats
Cells.Copy
Cells.PasteSpecial xlPasteValues
ActiveSheet.Name = wsName
Worksheets(wsName).Range("A1:R60").Locked = True
Sheets(wsName).Protect password:="walk", DrawingObjects:=True, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True  ' This seems to be where problem is
End Sub

The previous line to the password locking appears to be being run as the cells are shown as Locked in the protection sheet. However the password is not being applied. What confuses me is that the line is exactly the same as the line passwording the cover sheet.

Anyone got an idea why this is occuring??????????

Is the wsName variable filled when you use it to protect? I don't see where you're passing that name to the CopyRouteEmail sub

wsName is a varible that is DIMmed at the top of the module. Therefore I belive that it does not need to be passed but is still in scope. It appears to work on the previous line where it sets the cell Locked setting.

Hmm. If you're sure it's filled, try this

Sheets(wsName).Protect "walk"