' ZVI:2022-04-07 https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&TID=148740

Option Explicit

' Passwords and departments names
Const PwdSh01 = "000" ' <-- Password of Sh01 for Admin
Const Dep1 = "Отдел1", PwdDep1 = "125"
Const Dep2 = "Отдел2", PwdDep2 = "238"

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  With Sh01
    .Unprotect PwdSh01
    On Error Resume Next
    .Protection.AllowEditRanges(Dep1).Delete
    .Protection.AllowEditRanges(Dep2).Delete
    On Error GoTo 0
    .Protect PwdSh01, DrawingObjects:=True, Contents:=True, Scenarios:=True, _
                      AllowFormattingCells:=True, AllowFiltering:=True, _
                      UserInterfaceOnly:=True
    Application.OnTime Now, "'" & Me.Name & "'!" & Me.CodeName & ".WbOpen"
  End With
End Sub

Private Sub Workbook_Open()
  Application.OnTime Now, "'" & Me.Name & "'!" & Me.CodeName & ".WbOpen"
End Sub

Private Sub WbOpen()
  
  Dim i As Long, j As Long
  
  With Sh01
    
    ' Unprotect Sh01
    .Unprotect PwdSh01
    
    ' Del AllowEditRanges of Dep1 & Dep2
    On Error Resume Next
    .Protection.AllowEditRanges(Dep1).Delete
    .Protection.AllowEditRanges(Dep2).Delete
    On Error GoTo 0
    
    ' Find last row
    j = .UsedRange.Rows.Count + 1000
    If j < 10000 Then j = 10000
    
    ' Protect actual range of Dep1
    i = .UsedRange.EntireRow.Columns("b").Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, SearchFormat:=False).Row
    .Protection.AllowEditRanges.Add Dep1, .Range("A" & i + 1 & ":I" & j), PwdDep1
    
    ' Protect actual range of Dep2
    i = .UsedRange.EntireRow.Columns("k").Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, SearchFormat:=False).Row
    .Protection.AllowEditRanges.Add Dep2, .Range("J" & i + 1 & ":O" & j), PwdDep2
    
    ' Protect Sh01
    .Protect PwdSh01, DrawingObjects:=True, Contents:=True, Scenarios:=True, _
                      AllowFormattingCells:=True, AllowFiltering:=True, _
                      UserInterfaceOnly:=True
    
  End With
End Sub