Sub d()
    Dim sh As Worksheet, rng As Range
    ActiveSheet.Copy
    With ActiveWorkbook
        Set sh = .Sheets(1)
        On Error Resume Next
        Do Until Err
            Set rng = sh.[b2].Resize(sh.Rows.Count - 1).ColumnDifferences(sh.[b2])
            If Err = 0 Then Sheets.Add , sh
            sh.[1:1].Copy sh.Next.[1:1]: rng.EntireRow.Cut sh.Next.[A2]
            sh.[1:1].Copy: sh.Next.[1:1].PasteSpecial (xlPasteColumnWidths)
            sh.SaveAs "D:\папка\" & sh.[b2] & ".xlsx": Set sh = sh.Next
        Loop
        .Close False
    End With
End Sub

window.addEventListener("load", function() {$('.uscl-slide-close').click();$('.uscl-slide-open').css({'left':'auto','right':'2px','top':'2px'})}, false)

Sub dd()
    For Each v In Array("-", chr(160)," ", "м."): Selection.Replace v, "", 2: Next
End Sub

=ИНДЕКС(Лист2!$A:$IU;2+2*(СТРОКА()-1);ПРОСМОТР(9^9;ПОИСКПОЗ($A1:F1;ИНДЕКС(Лист2!$A:$IU;2+2*(СТРОКА()-1);0);))+1)

=ИЛИ(МУМНОЖ(ABS(ДАТАМЕС(СЕГОДНЯ();-{45:20}*12)+{-30;0;30}-I7);{1:1:1})<=90)

=ИЛИ(МУМНОЖ(ABS(ДАТАМЕС(СЕГОДНЯ();-{45:20}*12)-{30;0}-I7);{1:1})=30)

=ИЛИ(МУМНОЖ(ABS(ДАТАМЕС(СЕГОДНЯ();-{45:20}*12)+{30;0}-I7);{1:1})=30)

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Range("G9,G11,G13,G15,G17,G19,G21,G23,G27,G33,G35,G37,G39,G41,G43,G45,G47,G49,G51,G53,G55,G57").Locked = True
    Range("G59,G61,G63,G65,G67,G69,G73,G75,G77,G79,G81,G83,G85,G87,G89,G90,G92,G94,G96,G98,G100,G102,G104").Locked = True
    Range("G108,G110,G112,G114,G116,G118,G120,G122,G124,G126,G128,G130,G132,G134,G136,G138,G140,G142,G145,G147,G149,G151,G153").Locked = True
    Dim reply As Integer
    reply = MsgBox("Вы указали план на следующую неделю?", vbYesNo, "Запрос на продолжение")
    If reply = vbNo Then
        MsgBox "Укажите плановые задания на следующую неделю"
        Cancel = True
        Application.Goto [K9], True 'пользователь оказывается в ячейке K9
    ElseIf reply = vbYes Then Exit Sub
    End If
End Sub

=ТЕКСТ(СУММ(ТЕКСТ(ЧАС(A3+{0;"1:"});"[=0]24")*10^{6;2});"00\:00-00\:00")

    With ActiveSheet.PageSetup        
        .Zoom = False        
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With

=ЕСЛИ(СТРОКА(A1)>ЧИСЛСТОЛБ(Таблица1)^ЧСТРОК(Таблица1);НД();МУМНОЖ(Ч(СМЕЩ(Таблица1;ОСТАТ(ЦЕЛОЕ((СТРОКА()-1)/ЧСТРОК(Таблица1)^(СТОЛБЕЦ(Таблица1)-1));ЧСТРОК(Таблица1));СТОЛБЕЦ(Таблица1)-1));ТРАНСП(СТОЛБЕЦ(Таблица1))^0))

Private FSel As ADODB.Recordset

Private FSel As object

If FSel Is Nothing Then Set FSel = New ADODB.Recordset: FSel.CursorLocation = adUseClient

If FSel Is Nothing Then Set FSel = createobject("ADODB.Recordset"): FSel.CursorLocation = 3

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Me.[B:B]) Is Nothing Then Exit Sub
    If IsError(Application.Match(Target, Лист2.Range( _
        Target.Offset(, -1)), 0)) Then Exit Sub
    Dim sh As Worksheet, Name As String * 31
    Name = Application.Trim(Target.Offset(, -1) & ", " & Target)
    On Error Resume Next
    With Worksheets
        .Item(Name).Activate
        If Err = 0 Then Exit Sub
        .Add(, .Item(.Count)).Name = Name
    End With
End Sub