Range("C3").Replace What:="Дата экзамена: ", Replacement:=""
Range("C3").NumberFormat = "m/d/yyyy"
Range("C8:C11") = Range("C3").Value

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("Y5")) Is Nothing Then
Call б_ОбновитьФильтры
End If
End Sub

ActiveWorkbook.VBProject.VBComponents.Import "C:\Users\" & CreateObject("WScript.Network").UserName & "\Google Диск\!Distrib\КодЛиста.cls"

Sub SavePDF()
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\Users\" & CreateObject("WScript.Network").UserName & "\Desktop\" & ActiveWorkbook.Name & ".pdf"
End Sub

  ActiveSheet.Range("W7").AutoFilter Field:=23, Criteria1:="< & Range("W7").Value", _

Dim n%
    n = Cells(Rows.Count, "A").End(xlUp).Row
    Range("A & n:H" & n).AutoFill Destination:=Range("A1185:H" & n + 1), Type:=xlFillDefault
End Sub

     Dim ws As Worksheet, x As Range, i As Long, j As Long, a(), b(), c()
    Application.ScreenUpdating = False: Set ws = Sheets("Статистика")
    If ActiveSheet.Name = ws.Name Then
        MsgBox "Активируйте лист с данными!": Exit Sub
    End If
    a = ws.Range(ws.[B2], ws.Cells(4, ws.Cells(4, ws.Columns.Count).End(xlToLeft).Column)).Value
    b = Range("C8:K" & Cells(Rows.Count, 3).End(xlUp).Row).Value
    ReDim c(1 To 1, 1 To UBound(a, 2))
    For i = 1 To UBound(a, 2) Step 3: a(3, i) = a(1, i) & "|" & a(2, i): Next
    For i = 1 To UBound(b, 1): b(i, UBound(b, 2)) = b(i, 1) & "|" & b(i, 2): Next
    For i = 1 To UBound(a, 2) Step 3
        For j = 1 To UBound(b, 1)
            If a(3, i) = b(j, UBound(b, 2)) Then
                c(1, i) = b(j, 8): c(1, i + 1) = b(j, 7): c(1, i + 2) = b(j, 3): Exit For
    End If: Next: Next
    Set x = ws.[A:A].Find(CDate([B4]))
    If x Is Nothing Then
        i = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1: ws.Cells(i, 1) = CDate([B4])
    Else: i = x.Row
    End If
    ws.Cells(i, 2).Resize(, UBound(c, 2)).Value = c: ws.Rows(i).Replace "-", "", xlWhole

Cells.Replace What:="#N/A", Replacement:="", LookAt:=xlWhole, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False

Option Explicit

Private Const APPNAME = "Предложения"
Private Const SECTIONNAME = "Порядковые номера"
Private Const DOCNAME = "" 'Постоянная часть имени файла
Private Const DOCNUM = "Номер документа" 'Порядковый номер

Dim DefaultDocName As String 'Полное имя документа

'Макрос при создании нового документа на основе данного шаблона
Sub AutoNew()
    Dim nDocNum As Integer
    
    nDocNum = Val(GetSetting(APPNAME, SECTIONNAME, Key:=DOCNUM))
    DefaultDocName = DOCNAME & Format(Date, "yyyy/mm/dd")
    SaveSetting APPNAME, SECTIONNAME, Key:=DOCNUM, Setting:=nDocNum + 1
End Sub

'Переопределение процедуры "Сохранить"
Sub FileSave()
    If ActiveDocument.FullName = ActiveDocument.Name Then
        With Dialogs(wdDialogFileSaveAs)
            .Name = DefaultDocName
            .Show
        End With
    Else
        ActiveDocument.Save
    End If
End Sub

'Переопределение процедуры "Сохранить как..."
Sub FileSaveAs()
    With Dialogs(wdDialogFileSaveAs)
        .Name = DefaultDocName
        .Show
    End With
End Sub

Sub Статистика_разработка()
    
    Dim lngLastRow As Long
    lngLastRow = Sheets("Статистика").UsedRange.Rows.Count
    Sheets("Статистика").Cells(lngLastRow + 1, 1).Value = Range("B3").Value
    Sheets("Статистика").Cells(lngLastRow + 1, 2).Value = Range("C3").Value
    Sheets("Статистика").Cells(lngLastRow + 1, 3).Value = Range("J3").Value

End Sub

ActiveSheet.PageSetup.CenterHeaderPicture.Filename = _
        "\\путь\шаблон.jpg"
    With ActiveSheet.PageSetup.CenterHeaderPicture
    .Brightness = 0.6
    .Contrast = 0.4
    End With
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$Q:$AB"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = "&G"
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0.118110236220472)
        .FooterMargin = Application.InchesToPoints(0.118110236220472)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintSheetEnd
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlOverThenDown
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = False
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
End Sub

Sub Name()
    
    Range("B4").Replace what:="Текущая дата: ", Replacement:=""
    Range("B4").NumberFormat = "yyyy/mm/dd"
        
End Sub

Sub 333()

    Dim TextForFind, iRng As Range
        With ActiveSheet.Columns(3).Find 'поиск значения в третьем столбце
            TextForFind = Sheets("Лист1").Range("B2").Value 'Текст для поиска
                Set iRng = Columns(3).Find(what:=TextForFind, LookIn:=xlFormulas, lookat:=xlPart)'поиск значения в третьем столбце(нужно ли повторять??) поиск в формулах, искать не точное совпадение, а в содержимом ячеек
                If Not iRng Is Nothing Then  'правильна ли формулировка?
    Dim lngLastRow As Long
        lngLastRow = Sheets("лист1").UsedRange.Rows.Count
        Sheets("Лист1").Cells(lngLastRow, 2).Value = Range(iRng).Value  'здесь вообще отсебятина.... а должно быть найденное значение

End Sub

Sub 111()       Dim m%
    m = lngLastRow = Sheets("Лист1").UsedRange.Rows.Count
    Sheets("Лист1").Range [m + 1].Value = Range("B4").Value

End Sub

Sub 222()
Dim lngLastRow As Long
 
lngLastRow = Sheets("Лист1").UsedRange.Rows.Count

Sheets("Лист1").Range(lngLastRow + 1).Value = Range("B4").Value

End Sub

Sub Сохранить() 
' 
Range("A1").Select 
Selection.Copy 
Sheets("Лист2").Select 
ActiveSheet.Paste 
End Sub 

Sub Макрос1()    ' Макрос1 Макрос    ActiveSheet.Range("$B$7:$M$160".AutoFilter Field:=9, Criteria1:=Array( _
        "10150", "10400", "10600", "10650", "10670", "12000", "13039", "17300", "18750", "28700" _
        , "29101", "30300", "31560", "31600", "31700", "31800", "31830", "32100", "32332", _
        "32501", "32600", "32800", "33000", "33220", "33282", "33300", "33322", "33355", "33600" _
        , "33800", "34000", "34005", "34080", "34100", "34200", "34260", "34300", "34303", _
        "34400", "34450", "34500", "34650", "34715", "34750", "34755", "34800", "34850", "34901" _
        , "35000", "35050", "35251", "35300", "35350", "35450", "35518", "35519", "35700", _
        "35750", "36000", "36300", "36600", "36700", "37015", "37050", "37100", "37300", "37304" _
        , "37600", "38000", "38050", "38350", "7618", "8400", "9700", "=", Operator:= _
        xlFilterValuesEnd Sub

Sub Макрос1()    ' Макрос1 Макрос    ActiveSheet.Range("$B$7:$M$160".AutoFilter Field:=9, Criteria1:=Array( НЕ ВЫБИРАТЬ "-"; не выбирать "=".... ), Operator:= _
        xlFilterValuesEnd Sub