Sub Макрос4()
    ActiveCell.FormulaR1C1 = "=[@Оборот]-455"
End Sub

Sub Сьогодні()
    Range("AC4:AC22").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark2
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("X4:X22").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveWindow.SmallScroll Down:=-6
    Range("AC4:AC22").Select
    ActiveWindow.SmallScroll Down:=-21
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("X4:AC22").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ThemeColor = 3
        .TintAndShade = -0.249946592608417
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ThemeColor = 3
        .TintAndShade = -0.249946592608417
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ThemeColor = 3
        .TintAndShade = -0.249946592608417
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ThemeColor = 3
        .TintAndShade = -0.249946592608417
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ThemeColor = 3
        .TintAndShade = -0.249946592608417
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ThemeColor = 3
        .TintAndShade = -0.249946592608417
        .Weight = xlThin
    End With
    Range("A1").Select
End Sub

Sub Повестка_дня()
Application.ScreenUpdating = 0
Dim SCH_STR, LST_BD, LST_POVEST, DATA_POVEST, STR_PCH As Variant
Dim II As Integer

LST_BD = "База"
LST_POVEST = "Порядок"


Sheets(LST_BD).Select
SCH_STR = Cells(7, 1).End(xlDown).Row - 6
Dim MATR(), index() As Variant
ReDim MATR(SCH_STR, 1), index(SCH_STR, 1)
MATR = Range(Cells(7, 10), Cells(7 + SCH_STR - 1, 10))

Sheets(LST_POVEST).Select
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "=TODAY()"
DATA_POVEST = Range("J1").Value
    Range("A2:R15").Select
    Selection.Clear

STR_PCH = 2
For II = 1 To SCH_STR
    If DATA_POVEST = MATR(II, 1) Then
       Sheets(LST_BD).Select
       Rows(Trim(Str(II + 6)) + ":" + Trim(Str(II + 6))).Select
       Selection.Copy
    
       Sheets(LST_POVEST).Select
       Rows(Trim(Str(STR_PCH)) + ":" + Trim(Str(STR_PCH))).Select
       'ActiveSheet.Paste'ПОЛНАЯ ВСТАВКА (ФОРМАТЫ, ФОРМУЛЫ, ЗНАЧЕНИЯ)
       
' В С Т А В К А    БЕЗ    Ф О Р М У Л
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False 'ВСТАВКА ТОЛЬКО ФОРМАТОВ
        
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False 'ВСТАВКА ЗНАЧЕНИЙ И ЗНАЧЕНИЙ "ИЗ-ПОД" ФОРМУЛ В БД
       STR_PCH = STR_PCH + 1
    End If
Next 'II
Application.CutCopyMode = False
Application.ScreenUpdating = 1
End Sub

 

Public Function SumByColor(DataRange As Range, ColorSample As Range) As Double
    Dim Sum As Double
    Application.Volatile True

    For Each cell In DataRange
        If cell.Interior.Color = ColorSample.Interior.Color Then
            Sum = Sum + cell.Value
        End If
    Next cell
    SumByColor = Sum
End Function