Here is the answer:

Sub protectSheets()

Dim mySheet As Worksheet
Dim nomer As Integer
Dim ranTitle As String
nomer = 2


For Each mySheet In Worksheets

ranTitle = "Ran" & nomer

mySheet.Protection.AllowEditRanges.Add Title:=ranTitle,
Range:=mySheet.Range("D10:D14,D16:D32,D34:D35")

mySheet.Protect

nomer = nomer + 1

Next mySheet


End Sub


Thanks for your help!

"Sheeloo" wrote:

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