Sub F_1()
    
If MsgBox("Выполнить сортировку данных?", vbYesNo) = vbNo Then Exit Sub
    
ActiveWindow.WindowState = xlMinimized 'Свернуть книгу
    
Dim r As Long, arr
    arr = Array("янв", "фев", "мар", "апр", "май", "июн", "июл", "авг", "сен", "окт", "ноя", "дек", "итог")
    For r = 0 To 12 'Для 13 листов
        With Sheets(arr(r))
            .Visible = True
            .Unprotect 'Снять защиту листов
            .Rows("1:698").EntireRow.Hidden = False
        End With
    Next
    
    
    Dim t As String
    myARR = Array("янв", "фев", "мар", "апр", "май", "июн", "июл", "авг", "сен", "окт", "ноя", "дек", "итог")
    Set myDict = CreateObject("scripting.dictionary")
    myDict.comparemode = 1  ''сравнение без учёта регистра
    For i = LBound(myARR) To UBound(myARR)
        DoEvents
        t = myARR(i)
        myDict(t) = t
    Next
    
    
    Application.ScreenUpdating = False
    
    
    shB.Unprotect
    If [O1].ID = "А_Я" Or [O1].ID = "" Then
        [O1].ID = "Я_А"
        myOrd = 1
    Else
        [O1].ID = "А_Я"
        myOrd = 2
    End If
    
    shB.Sort.SortFields.Clear
    shB.Sort.SortFields.Add Key:=shB.Range("O2"), _
    SortOn:=xlSortOnValues, Order:=myOrd, DataOption:=xlSortNormal
    With shB.Sort
        .SetRange shB.Range("O2:P41")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    shB.Protect
    
    For i = 1 To Sheets.Count
        t = Sheets(i).Name
        If myDict.Exists(t) Then
            'Sheets(i).Unprotect
            Sheets(i).Sort.SortFields.Clear
            Sheets(i).Sort.SortFields.Add Key:=Sheets(i).Range("B21"), _
            SortOn:=xlSortOnValues, Order:=myOrd, DataOption:=xlSortNormal
            With Sheets(i).Sort
                .SetRange Sheets(i).Range("B21:AH60")
                .Header = xlGuess
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            Sheets(i).Activate
            Sheets(i).Range("A1").Select
            'Sheets(i).Protect
        End If
    Next


For r = 0 To 12
    With Sheets(arr(r))
        .Rows("1:698").EntireRow.Hidden = True
        .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 'Установить защиту листов
        .Visible = False
    End With
Next
    
    
    Application.ScreenUpdating = True
    
ActiveWindow.WindowState = xlMaximized 'Развернуть книгу

End Sub

Sub Макрос1()
For Each wb In Workbooks
    If wb.Name = "Книга2.xlsm" Then 'Если книга открыта
        Windows("Книга2.xlsm").Visible = False     'Скрыть окно проверяемой открытой книги
    Exit For
    End If
Next wb
        'Выполнить Оператор1 при закрытой или открытой Книги2
End Sub