Maybe this will help, I have created a macro which will
prompt the user for one password which works for all the
sheets or individually.
Here is the code I wrote, I hope it helps:
Sub Protect_All_Sheets()
' Protect_All_Sheets Macro
' Macro recorded 3/3/2001 by David Allen Marden
'
'This Macto Can Be Used In Any Excel Project
Dim CurrentSheetName As String
Dim Password As String
Dim CheckPassword As String
Dim Decision As String
CurrentSheetName = ActiveSheet.Name
Sheets(1).Select
'Check if sheet is protected.
j = 1
If ActiveSheet.ProtectContents = False Then
Do While ActiveSheet.ProtectContents = False
'If not, get a password
Password = InputBox("Enter a password for this
sheet")
CheckPassword = InputBox("Re Enter Password for
this sheet")
If CheckPassword = Password Then
ProtectNext = True
If j = 1 Then
Sheet1ProtectionChanges
End If
If j = 2 Then
Sheet2ProtectionChanges
End If
If j = 3 Then
Sheet3ProtectionChanges
End If
If j = 4 Then
Sheet4ProtectionChanges
End If
ProtectNext = False
Range("Sheet" & j & "Protection").Value
= "True"
j = j + 1
'ActiveSheet.Protect (Password)
ActiveSheet.Protect (Password),
DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True,
AllowSorting:=True
Else: MsgBox ("Passwords did not Match")
End If
Loop
End If
Decision = InputBox("Typing G will copy last password
to all other sheets, Typing I will individualize all
sheets, If you type anything else then the first page
protected is the only page that will get protected.")
If Decision = "i" Or Decision = "I" Then
For i = 1 To Sheets.Count - 1
ActiveSheet.Next.Select
'Check if sheet is protected.
If ActiveSheet.ProtectContents = False Then
Do While ActiveSheet.ProtectContents = False
'If not, get a password
Password = InputBox("Enter a password for
this sheet")
CheckPassword = InputBox("Re Enter Password
for this sheet")
If CheckPassword = Password Then
'Set Password
ProtectNext = True
If j = 1 Then
Sheet1ProtectionChanges
End If
If j = 2 Then
Sheet2ProtectionChanges
End If
If j = 3 Then
Sheet3ProtectionChanges
End If
If j = 4 Then
Sheet4ProtectionChanges
End If
ProtectNext = False
Range("Sheet" & j & "Protection").Value
= "True"
j = j + 1
'ActiveSheet.Protect (Password)
ActiveSheet.Protect (Password),
DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True,
AllowSorting:=True
Else: MsgBox ("Passwords did not Match")
End If
Loop
End If
Next
End If
If Decision = "g" Or Decision = "G" Then
For i = 1 To Sheets.Count - 1
ActiveSheet.Next.Select
If ActiveSheet.ProtectContents = False Then
ProtectNext = True
If j = 1 Then
Sheet1ProtectionChanges
End If
If j = 2 Then
Sheet2ProtectionChanges
End If
If j = 3 Then
Sheet3ProtectionChanges
End If
If j = 4 Then
Sheet4ProtectionChanges
End If
ProtectNext = False
Range("Sheet" & j & "Protection").Value
= "True"
j = j + 1
'ActiveSheet.Protect (Password)
ActiveSheet.Protect (Password),
DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True,
AllowSorting:=True
End If
Next
End If
Sheets(CurrentSheetName).Select
Range("D4").Select
End Sub
Sub Unprotect_All_Sheets()
' Unprotect_All_Sheets Macro
' Macro recorded 3/3/2001 by David Allen Marden
'
' This Macto Can Be Used In Any Excel Project
Dim CurrentSheetName As String
Dim Password As String
Dim CheckPassword As String
Dim Decision As String
CurrentSheetName = ActiveSheet.Name
Sheets(1).Select
'Check if sheet is protected.
If ActiveSheet.ProtectContents = True Then
Do While ActiveSheet.ProtectContents = True
'If not, get a password
Password = InputBox("Enter the password for this
sheet")
'Reset Password
ActiveSheet.Unprotect (Password)
Loop
End If
Decision = InputBox("Typing G will use the last
password to unprotect all other sheets, Typing I will
individualize all sheets, If you type anything else then
the first page protected is the only page that will get
unprotected.")
If Decision = "i" Or Decision = "I" Then
For i = 1 To Sheets.Count - 1
ActiveSheet.Next.Select
'Check if sheet is protected.
If ActiveSheet.ProtectContents = True Then
Do While ActiveSheet.ProtectContents = True
'If not, get a password
Password = InputBox("Enter a password for
this sheet")
'Reset Password
ActiveSheet.Unprotect (Password)
Loop
End If
Next
End If
If Decision = "g" Or Decision = "G" Then
For i = 1 To Sheets.Count - 1
ActiveSheet.Next.Select
If ActiveSheet.ProtectContents = True Then
ActiveSheet.Unprotect (Password)
End If
Next
End If
Sheets(1).Select
For i = 1 To 4
Sheets(1).Select
If ActiveSheet.ProtectContents = False Then
ProtectNext = False
Range("Sheet" & i & "Protection").Value
= "False"
Else: Range("Sheet" & i & "Protection").Value
= "True"
End If
If i = 1 Then
Sheet1ProtectionChanges
End If
If i = 2 Then
Sheet2ProtectionChanges
End If
If i = 3 Then
Sheet3ProtectionChanges
End If
If i = 4 Then
Sheet4ProtectionChanges
End If
If i < 4 Then
ActiveSheet.Next.Select
End If
Next
Sheets(CurrentSheetName).Select
Range("A1").Select
End Sub