Here is the code;
(Adapted from
http://www.tanguay.info/web/codeExample.php?id=896)
You need to call the macro protectSheets()
Each sheet should have a range named MyRange1, MyRange2,... for first,
second,... sheets.
You may adapt it as per your requirements.
Let me know how it goes.
'___________
'tool: protects any number of areas (ranges) of a sheet, send them
semi-colon separated as e.g. "A1:F20;B1:B100"
Function qexc_ProtectAreaOfSheet(strSheetName As String,
strRangeNamesToProtect As String, strPassword As String)
'declarations
Dim arrRangeNames() As String
Dim intIndex As Integer
'variables
arrRangeNames = qstr_BreakIntoParts(strRangeNamesToProtect, ";")
'unprotect the sheet so you can unlock the cells
Sheets(strSheetName).Unprotect (strPassword)
'unlock all cells in sheet
Sheets(strSheetName).Cells.Locked = False
'lock the cells that you want to protect
For intIndex = 0 To UBound(arrRangeNames)
'variables
strrangeName = arrRangeNames(intIndex)
'lock cells for this range
Sheets(strSheetName).Range(strrangeName).Locked = True
Next
'protect the range they specified
Sheets(strSheetName).Protect Password:=strPassword, Contents:=True,
Scenarios:=True, UserInterfaceOnly:=True
End Function
'tool: this function acts like split, but also trims, takes e.g. "log1.txt,
log2.txt, log3.txt" and returns the array("log1.txt", "log2.txt", "log3.")
without the spaces on the left isde
Function qstr_BreakIntoParts(ByVal strLine As String, strSeparator As String)
'declarations
Dim ra() As String
Dim arrParts() As String
Dim intNumberOfParts As Integer
Dim intIndex As Integer
Dim strPart As Variant
Dim strCleanedPart As String
'variables
arrParts = Split(strLine, strSeparator)
intNumberOfParts = UBound(arrParts) + 1
ReDim Preserve ra(intNumberOfParts - 1)
'assign
intIndex = 0
For Each strPart In arrParts
'variables
strCleanedPart = Trim(strPart)
'add it
ra(intIndex) = strCleanedPart
'increment
intIndex = intIndex + 1
Next
qstr_BreakIntoParts = ra
End Function
Sub protectSheets()
Dim mySheet As Worksheet
Dim rngName As String
Dim rngOnSheet As String
Dim i
Dim j
rngName = "MyRange"
i = 1
For Each mySheet In Worksheets
rngOnSheet = rngName & i
j = qexc_ProtectAreaOfSheet(mySheet.Name, rngOnSheet, "abc123")
i = i + 1
Next mySheet
MsgBox "Completed."
End Sub