Sub qwe()
      Dim r As Range, c As Range
      Set r = [E:E].SpecialCells(2, 23).SpecialCells(12)
      Application.ScreenUpdating = 0
      [I:P].EntireColumn.Hidden = True
      For Each c In [I2:P2]
          If Not r.Find(c, , xlValues, xlWhole) Is Nothing Then c.EntireColumn.Hidden = 0
      Next
End Sub

.SetSourceData Source:=Evaluate("offset(" & xBufferName(1) & ",,,,2)")

=ЕСЛИ(И(ЕЧЁТН(МУМНОЖ(ЗНАК(ABS(A4:B11));ТРАНСП(ЗНАК(ABS(A4:B11))))));"ошибка";"нет ошибки")

Sub qwe()
      With Application: .ScreenUpdating = 0: .EnableEvents = 0: .DisplayAlerts = 0
          With ActiveWorkbook.Worksheets("Лист1").Sort
              With .SortFields
                  .Clear
                  .Add Intersect([A1].CurrentRegion, [E:E]), 0, 1, 0
                  .Add Intersect([A1].CurrentRegion, [F:F]), 0, 1, 0
                  .Add Intersect([A1].CurrentRegion, [D:D]), 0, 1, 0
              End With
              .SetRange [A1].CurrentRegion
              .Header = xlYes
              .MatchCase = False
              .Orientation = xlTopToBottom
              .SortMethod = xlPinYin
              .Apply
          End With
          Dim col As Range, rcnt&, rnum&: rnum = 2
          With Intersect([A2].CurrentRegion, [E:G], ActiveSheet.UsedRange.Offset(1))
              .Select
              Do
                  On Error Resume Next
                  Selection.ColumnDifferences(ActiveCell).Select
                  rcnt = Selection.Row - rnum: rnum = Selection.Row
                  If rcnt > 1 Then
                      For Each col In .Rows(rnum).Offset(-rcnt - 1).Resize(rcnt).Columns
                          col.Merge
                      Next
                  End If
              Loop Until Err.Number
              If Selection.Rows.Count > 1 Then
                  For Each col In Selection.Columns
                      col.Merge
                  Next
              End If
          End With
          Intersect([A1].CurrentRegion, [D:D]).Cut
          Intersect([A1].CurrentRegion.EntireRow, [H:H]).Insert Shift:=xlToRight
          Intersect([A1].CurrentRegion, [D:G]).Cut
          Intersect([A1].CurrentRegion, [A:A]).Insert Shift:=xlToRight
      .ScreenUpdating = 1: .EnableEvents = 1: .DisplayAlerts = 1: End With
End Sub

Sub Макрос()
      Dim arr As Variant
      Application.ScreenUpdating = 0: Application.EnableEvents = 0
      With Intersect(ActiveSheet.UsedRange, [A:G])
          .Copy .Offset(, .Columns.Count + 1)
          With .Offset(, .Columns.Count + 1)
              .UnMerge: .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
              .Copy: .PasteSpecial Paste:=xlPasteValues: .ClearFormats
              arr = .Resize(, 1): .Resize(, 1).Value = .Offset(, 4).Resize(, 1).Value
              .Offset(, 4).Resize(, 1).Value = arr: arr = .Offset(, 1).Resize(, 1)
              .Offset(, 1).Resize(, 1).Value = .Offset(, 5).Resize(, 1).Value
              .Offset(, 5).Resize(, 1).Value = arr: arr = .Offset(, 6).Resize(, 1).Value
              .Offset(, 6).Resize(, 1).Value = .Offset(, 2).Resize(, 1).Value
              With .Offset(, 2).Resize(, 1)
                  .Formula = arr: .NumberFormat = "dd.mm.yy hh:mm"
              End With
              .Columns.AutoFit
          End With
      End With
      Application.CutCopyMode = False
      Application.ScreenUpdating = 1: Application.EnableEvents = 1
End Sub

Private Function GetPrinter$(PrinterName$)
       Dim StrKey$: StrKey = "HKCU\Software\Microsoft\Windows NT\CurrentVersion\Devices\"
       With CreateObject("WScript.Shell")
           GetPrinter = PrinterName & " (" & Split(.RegRead(StrKey & PrinterName), ",")(1) & ")"
       End With
End Function
Sub DefinePrinters()
       On Error Resume Next
       Me.CustomDocumentProperties.Add "книга", 0, 4, "Принтер" 'задаем принтер для этой книги
       CustomDocumentProperties("книга") = "Принтер" 'если принтер для этой книги был задан раньше
       Me.CustomDocumentProperties.Add "Лист1", 0, 4, "Canon Inkjet iP4600 series" 'задаем принтер для Листа1
       CustomDocumentProperties("Лист1") = "Canon Inkjet iP4600 series" 'если принтер для Листа1 был задан раньше
       Me.CustomDocumentProperties.Add "Лист2", 0, 4, "Принтер2"
       CustomDocumentProperties("Лист2") = "Принтер2"
       Me.CustomDocumentProperties.Add "Лист3", 0, 4, "Принтер3"
       CustomDocumentProperties("Лист3") = "Принтер3"
End Sub
Private Sub Workbook_BeforePrint(Cancel As Boolean)
       With ActiveWindow.SelectedSheets
           Application.ActivePrinter = GetPrinter(CustomDocumentProperties(IIf(.Count > 1, "книга", .Item(1).Name)))
       End With
End Sub

Function GetPrinters() As Variant
      Dim coll As Collection: Set coll = New Collection
      Dim StrKey$: StrKey = "HKCU\Software\Microsoft\Windows NT\CurrentVersion\Devices\"
      Dim n&, arr()
      With GetObject("winmgmts://./root/CIMV2")
          For Each Printer In .ExecQuery("SELECT * FROM Win32_Printer", , 48)
              ReDim Preserve arr(n): arr(n) = Printer.Name n = n + 1
          Next
      End With
      GetPrinters = arr
End Function

Sub RemoveDuplicates()
     Intersect(ActiveSheet.UsedRange, [A:B]).RemoveDuplicates Array(1, 2), 2
end sub

Private Function GetPrinter$(PrinterName$)
      Dim StrKey$: StrKey = "HKCU\Software\Microsoft\Windows NT\CurrentVersion\Devices\"
      With CreateObject("WScript.Shell")
          GetPrinter = PrinterName & " (" & Split(.RegRead(StrKey & PrinterName), ",")(1) & ")"
      End With
End Function
Private Sub Workbook_Activate()
      On Error Resume Next
      Me.CustomDocumentProperties.Add "printer", 0, 4, "имя принтера"
      CustomDocumentProperties("printer") = "имя принтера"
      Parent.ActivePrinter = GetPrinter(CustomDocumentProperties("printer"))
End Sub

=МИН(ЕСЛИ($C$12:$C$15>=C6;$C$12:$C$15))

Sub пример_использования()
      If Application.Dialogs(xlDialogPrinterSetup).Show Then PrintPages "1-3,4,5-7"
End Sub

Sub PrintPages(StrPages$)
      For Each rr In Split(StrPages$, ",")
          ActiveWindow.SelectedSheets.PrintOut Split(rr, "-")(0), Split(rr, "-")(IIf(InStr(rr, "-"), 1, 0)), 1
      Next
End Sub
Sub пример_использования()
      PrintPages "1-3,10-15,20-60"
End Sub

=ЕСЛИОШИБКА(СМЕЩ(ДВССЫЛ(ТЕКСТ($D$1;"ММММ")&"!A1");ПОИСКПОЗ(A3;ДВССЫЛ(ТЕКСТ($D$1;"ММММ")&"!A:A"););ДЕНЬ($D$1));"")

=ЕСЛИОШИБКА(ПРОСМОТР(ВПР(A3;ДВССЫЛ(ТЕКСТ($D$1;"ММММ")&"!1:"&4^8);ДЕНЬ($D$1)+1;);{0;9};ВПР(A3;ДВССЫЛ(ТЕКСТ($D$1;"ММММ")&"!1:"&4^8);ДЕНЬ($D$1)+1;));"")

=ЕСЛИОШИБКА(ПРОСМОТР(ВПР(A3;ДВССЫЛ(ТЕКСТ($D$1;"ММММ")&"!1:"&4^8);ДЕНЬ($D$1)+1;);{9;26};ВПР(A3;ДВССЫЛ(ТЕКСТ($D$1;"ММММ")&"!1:"&4^8);ДЕНЬ($D$1)+1;));"")

=ЕСЛИОШИБКА(ПРОСМОТР(ВПР(A3;ДВССЫЛ(ТЕКСТ($D$1;"ММММ")&"!1:"&4^8);ДЕНЬ($D$1)+1;);31;ВПР(A3;ДВССЫЛ(ТЕКСТ($D$1;"ММММ")&"!1:"&4^8);ДЕНЬ($D$1)+1;));"")

=ЕСЛИОШИБКА(СУММ((ЕСЛИОШИБКА(ВПР(ПРОСМОТР(G$3;ЦЕЛОЕ(РАЗНДАТ(6;КОНМЕСЯЦА(ДАТАМЕС(G$3;-МЕСЯЦ(G$3));0);"d")/7)*7+6+14*(СТРОКА($1:$28)-1))+14;$A$2:$B$16;2;)*(17-G$3+ПРОСМОТР(G$3;ЦЕЛОЕ(РАЗНДАТ(6;КОНМЕСЯЦА(ДАТАМЕС(G$3;-МЕСЯЦ(G$3));0);"d")/7)*7+6+14*(СТРОКА($1:$28)-1)))/14;)+ЕСЛИОШИБКА(ВПР(ПРОСМОТР(G$3;ЦЕЛОЕ(РАЗНДАТ(6;КОНМЕСЯЦА(ДАТАМЕС(G$3;-МЕСЯЦ(G$3));0);"d")/7)*7+6+14*(СТРОКА($1:$28)-1))+28;$A$2:$B$16;2;);)+ЕСЛИОШИБКА(ВПР(ПРОСМОТР(G$3;ЦЕЛОЕ(РАЗНДАТ(6;КОНМЕСЯЦА(ДАТАМЕС(G$3;-МЕСЯЦ(G$3));0);"d")/7)*7+6+14*(СТРОКА($1:$28)-1))+42;$A$2:$B$16;2;)*(КОНМЕСЯЦА(G$3;0)-30-ПРОСМОТР(G$3;ЦЕЛОЕ(РАЗНДАТ(6;КОНМЕСЯЦА(ДАТАМЕС(G$3;-МЕСЯЦ(G$3));0);"d")/7)*7+6+14*(СТРОКА($1:$28)-1)))/14;))^{0;1})-1;"нет данных")

=ЕСЛИОШИБКА(СУММ(СУММ((ЕСЛИ(ЕНД(ПОИСКПОЗ($A$2:$A$16;ЦЕЛОЕ(РАЗНДАТ(6;КОНМЕСЯЦА(ДАТАМЕС(G$3;-МЕСЯЦ(G$3));0);"d")/7)*7+6+14*(СТРОКА($1:$28)-1);))*((ДЕНЬНЕД($A$2:$A$16)<>6)+(ЕНЕЧЁТ(НОМНЕДЕЛИ(--$A$2:$A$16))));$A$2:$A$16;)>=G$3)*(ЕСЛИ(ЕНД(ПОИСКПОЗ($A$2:$A$16;ЦЕЛОЕ(РАЗНДАТ(6;КОНМЕСЯЦА(ДАТАМЕС(G$3;-МЕСЯЦ(G$3));0);"d")/7)*7+6+14*(СТРОКА($1:$28)-1);))*((ДЕНЬНЕД($A$2:$A$16)<>6)+(ЕНЕЧЁТ(НОМНЕДЕЛИ(--$A$2:$A$16))));$A$2:$A$16;)<=КОНМЕСЯЦА(G$3;0))*(($C$2:$C$16="%")*$B$3:$B$17*$B$2:$B$16%+($C$2:$C$16="bonus")*$B$2:$B$16))^{0;1})-1;"")