Sub Макрос2()

'Записано макросом. При запуске макроса - работает
    ActiveSheet.Range("$B$23:$F$500").AutoFilter Field:=2, Criteria1:=Array( _
        "Зав.секцией", "кассир", "Кассир ТЗ"), Operator:=xlFilterValues
'Заменил условия отбора и опробовал код. Не работает
    ActiveSheet.Range("$B$23:$F$500").AutoFilter Field:=2, Criteria1:=Array( _
        "РОП", "МКО2К", "менеджер дизайн студии", "МКО1К"), Operator:=xlFilterValues
End Sub

Image5.Left = -204
For i = -204 To 12
DoEvents
i = i + 0.00000005
DoEvents
Image5.Left = i
DoEvents
Application.Wait Now + ((TimeValue("00:00:01") / 1000) * 200)
DoEvents

Private Sub CommandButton1_Click()
End
End Sub
Private Sub UserForm_Activate()
On Error Resume Next
Do
Label1 = Format(Date, "dddd, dd mmm yyyy")
Label2 = Format(Time, "hh:mm:ss AM/PM")
Label3.Left = Label3.Left - 2
If Label3.Left <= 0 - Label3.Width Then Label3.Left = Me.Width
For i = 1 To 8000000
Next
DoEvents
Loop
End Sub

            Dim myPhrase As Variant, myCell As Range
            Workbooks(1).Activate
            myPhrase = Range("F4").Value 'Это дата в ячейке
            Workbooks(2).Activate
          
                Set myCell = Range("G2:G1200").Find(myPhrase)
                If Not myCell Is Nothing Then
                    MsgBox myCell.Row 'выводит номер строки, если нашел
                Else
                MsgBox "даты нет!"
                myPhrase = myPhrase + 1
                'Нужно настроить цикл на поиск ближайшей большей даты myPhrase, чтобы возвращал на If
                End If

Sub ПЕРЕИМЕНОВАТЬ_ЛИСТЫ_СОГЛАСНО_ТЕКСТА_В_ДИАПАЗОНЕ()
'Шаг 1: Объявить переменные
Dim MyRange As Range
Dim i As Long
Dim MyCell As Range
'Шаг 2: Определение целевого диапазона.
Set MyRange = Range("B1:K1") 'ДИАПАЗОН СО ЗНАЧЕНИЯМИ ДЛЯ ПЕРЕИМЕНОВАНИЯ ЛИСТОВ
i = 3
'Шаг 3: Запуск цикла через диапазон.
For Each MyCell In MyRange
'Шаг 4: Какое-либо действие с каждой ячейкой.
If MyCell.Value = "" Then
Exit Sub
ElseIf MyCell.Value <> "" Then
Application.ScreenUpdating = False
            Worksheets(i).Name = MyCell.Value
Application.ScreenUpdating = True
'Шаг 5: Перейти к следующей ячейке в диапазоне

i = i + 1
End If
'Шаг 5: Перейти к следующей ячейке в диапазоне
Next MyCell
End Sub

If ActiveWorkbook.Name <> Workbooks(1).Name Then
    MsgBox (Space(50) & "ВНИМАНИЕ!" & Chr(13) & Space(5) & "В этой процедуре следует закрыть все предыдущие, ранее открытые файлы Excel.")
Else
    MsgBox ActiveWorkbook.Name
End If

If ActiveWorkbook./Index/ <> 1 Then
    MsgBox (Space(50) & "ВНИМАНИЕ!" & Chr(13) & Space(5) & "В этой процедуре следует закрыть все предыдущие, ранее открытые файлы Excel.")
Else
    MsgBox ActiveWorkbook.Name
End If

ActiveWorkbook.Close SaveChanges:=True

        'ActiveWorkbook.Unprotect Password:="123456" 'Range("AH1").Value ' ЗДЕСЬ РУГАЕТСЯ, ЧТО ПАРОЛЬ НЕ ВЕРНЫЙ
        'ActiveWorkbook.Protect Password:="8888" 'Range("AI1").Value
        
        ThisWorkbook.Unprotect Password:="123456" 'Если пароля нету, то только ThisWorkbook.Unprotect
        'Установка защиты
        ThisWorkbook.Protect Password:="8888"
                
        ActiveWorkbook.Close SaveChanges:=True