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:
  1. Sub mnuEmail()

  2. Dim tmp

  3. Dim Bookname As String

  4. Application.ScreenUpdating = False

  5. 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")

  6. If tmp = vbYes Then

  7.     Bookname = "c:\temp\Routecard(Email).xls"

  8.     OriginalBook = ActiveWorkbook.Name

  9.     Workbooks.Add

  10.     ActiveWorkbook.SaveAs FileName:=Bookname

  11.     NewBook = ActiveWorkbook.Name

  12.     WkShtNew = Worksheets.Count

  13.     If Workbooks(OriginalBook).Sheets("Cover").Range("J6").Value = "One Day Practice" Then

  14.         WkShtRequire = 2

  15.         Call SetUpEmailBook

  16.         wsName = "Day 1"

  17.         x = 2

  18.         Call CopyRouteEmail

  19.     End If

  20.     If Workbooks(OriginalBook).Sheets("Cover").Range("J6").Value = "Bronze Level Expedition" Then

  21.         WkShtRequire = 3

  22.         Call SetUpEmailBook

  23.         wsName = "Day 1"

  24.         x = 2

  25.         Call CopyRouteEmail

  26.         wsName = "Day 2"

  27.         x = 3

  28.         Call CopyRouteEmail

  29.     End If

  30.     ActiveWorkbook.SendMail "", "RouteCards"

  31.     Workbooks(NewBook).Close False

  32.     Kill Bookname

  33. End If

  34. Call ReactivateScreen

  35. End Sub

  36.  
  37. Sub SetUpEmailBook()

  38. If WkShtNew <> WkShtRequire Then

  39.     If WkShtNew > WkShtRequire Then

  40.         Application.DisplayAlerts = False

  41.         Do Until WkShtNew = WkShtRequire

  42.             Sheets(WkShtNew).Delete

  43.             WkShtNew = WkShtNew - 1

  44.         Loop

  45.         Application.DisplayAlerts = True

  46.     End If

  47.     If WkShtNew < WkShtRequire Then

  48.         Do Until WkShtNew = WkShtRequire

  49.             Sheets(WkShtNew).Add

  50.             WkShtNew = WkShtNew - 1

  51.         Loop

  52.     End If

  53. End If

  54. Workbooks(OriginalBook).Activate

  55. Sheets("Cover").Select

  56. Cells.Copy

  57. Workbooks(NewBook).Activate

  58. Sheets(1).Select

  59. Cells.PasteSpecial xlPasteAll

  60. Cells.Copy

  61. Cells.PasteSpecial xlPasteValues

  62. ActiveSheet.Name = "Cover"

  63. Worksheets("Cover").Range("A1:R43").Locked = True

  64. Sheets("Cover").Protect password:="ranger", DrawingObjects:=True, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True ' This part protects sheet Cover OK

  65. End Sub

  66.  
  67. Sub CopyRouteEmail()

  68. Workbooks(OriginalBook).Activate

  69. Sheets(wsName).Select

  70. Range("A1:R60").Select

  71. Cells.Copy

  72. Workbooks(NewBook).Activate

  73. Sheets(x).Select

  74. Cells.PasteSpecial xlPasteValues

  75. Workbooks(OriginalBook).Activate

  76. Sheets(wsName).Select

  77. Range("A1:R60").Select

  78. Cells.Copy

  79. Workbooks(NewBook).Activate

  80. Sheets(x).Select

  81. Cells.PasteSpecial xlPasteFormats

  82. Cells.Copy

  83. Cells.PasteSpecial xlPasteValues

  84. ActiveSheet.Name = wsName

  85. Worksheets(wsName).Range("A1:R60").Locked = True

  86. Sheets(wsName).Protect password:="walk", DrawingObjects:=True, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True  ' This seems to be where problem is

  87. 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??????????