.CenterFooter = "&""Times New Roman""&8" & ['Яблоко'!A2]
    .RightFooter = "&""Times New Roman""&8 Стр &P из &N"

=ТЕКСТ(ДАТА(M2;(ПОИСК(ЛЕВБ(ПОДСТАВИТЬ(H2;"мая";"май");3);"янвфевмарапрмайиюниюлавгсеноктноядек")+2)/3;E2)+1;"[$-x-sysdate]дд ММММ гггг \г.")

=СУММПРОИЗВ(($B$2:$B$6=B$22)*($D$2:$D$6=$A23)*($E$1:$J$1=$C$14)*($E$2:$J$6>0)*($E$2:$J$6<>"б/д"))

rngData.Copy
wbReport.Worksheets(1).Cells(n + 1, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False

Private Sub Worksheet_Change(ByVal Target As Range)
    'проверка: если столбец не I - выход
    If Target.Column <> 9 Then Exit Sub
    'проверка: если строка меньше 2 - выход
    If Target.Row < 2 Then Exit Sub
    'проверка: если изменили более одной ячейки - выход
    If Target.Count > 1 Then Exit Sub
    'проверка: если в ячейку ничего не ввели(удаление) - выход
    If Len(Target) = 0 Then Exit Sub
      
    Dim s$
    'создаем путь к файлу
    s = "C:\tmp\" & Target.Value & ".pdf"
    'отключаем отслеживание событий, чтобы не было зацикливания при создании ссылки
    Application.EnableEvents = 0
    'создаем гиперссылку
    Me.Hyperlinks.Add Anchor:=Target, Address:=s, TextToDisplay:=CStr(Target.Value)
    'возвращаем отслеживание событий
    Application.EnableEvents = 1
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column <> 9 Then Exit Sub
    If Target.Row < 2 Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Len(Target) = 0 Then Exit Sub
     
    Dim s$
    s = "C:\tmp\" & Target.Value & ".pdf"
    Application.EnableEvents = 0
    Me.Hyperlinks.Add Anchor:=Target, Address:=s, TextToDisplay:=CStr(Target.Value)
    Application.EnableEvents = 1
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column <> 9 Then Exit Sub
    If Target.Row < 2 Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Len(Target) = 0 Then Exit Sub
    
    Dim s$
    s = "C:\tmp\" & Target.Value & ".pdf"
    Application.EnableEvents = 0
    Me.Hyperlinks.Add Anchor:=Target, Address:=s, TextToDisplay:=Target.Value
    Application.EnableEvents = 1
End Sub

=ЕСЛИОШИБКА(ИНДЕКС($E$1:$E$45;НАИМЕНЬШИЙ(ЕСЛИ($D$1:$D$45=D5;СТРОКА($E$1:$E$45));1));"")

=ЕСЛИОШИБКА(ИНДЕКС($F$1:$F$45;НАИМЕНЬШИЙ(ЕСЛИ($D$1:$D$45=D5;СТРОКА($E$1:$E$45));1));"")

=ЕСЛИОШИБКА(ИНДЕКС($E$1:$E$45;НАИМЕНЬШИЙ(ЕСЛИ($D$1:$D$45=D5;СТРОКА($E$1:$E$45));2));"")

=ЕСЛИОШИБКА(ИНДЕКС($F$1:$F$45;НАИМЕНЬШИЙ(ЕСЛИ($D$1:$D$45=D5;СТРОКА($E$1:$E$45));2));"")

=ЕСЛИОШИБКА(НАИМЕНЬШИЙ(ЕСЛИ($D$1:$D$45=D5;$E$1:$E$45);1);"")

=ПОДСТАВИТЬ(ЗНАК(B3-A3);1;"")&ТЕКСТ(ABS(B3-A3);"[м] ""мин"" сс ""сек""")

"*******";"*******";"*******";"*******"

Sub triming()
   Dim trim_range  As Range
   Set trim_range = Range("B:B")
   Set trim_range = Intersect(trim_range, ActiveSheet.UsedRange)
   If not trim_range is nothing then
      With trim_range
         .Value = Application.Trim(.Value)
      End With
   end if
End Sub

=СУММЕСЛИ($G$1:$AK$1; "<="&ДЕНЬ($B$2); G3:AK3)+C3

Set ws = ActiveWorkbook.Worksheets("Фрукты") 'лист, куда переносить данные

ws.Cells.Clear

Sub ВставляетЗначениеВыбор()
    Dim oFD As FileDialog
    Dim wb As Workbook, ws As Worksheet, wsAct As Worksheet
    Dim path$
    Set oFD = Application.FileDialog(msoFileDialogFilePicker)
    With oFD
        .AllowMultiSelect = False
        .Title = "Выбрать файл"
        .Filters.Clear
        .Filters.Add "All files", "*.*"
        .InitialFileName = ActiveWorkbook.path
        .InitialView = msoFileDialogViewDetails
        If oFD.Show = 0 Then Exit Sub
    End With
    path = oFD.SelectedItems(1)
    Set wsAct = ActiveSheet
    Set ws = ActiveWorkbook.Worksheets("Фрукты") 'лист, куда переносить данные
    
    Application.ScreenUpdating = False 'Выключаем обновление экрана
    Set wb = Workbooks.Open(path)
    'sAddress = "A1:G100" 'или одна ячейка - "A1"
    'vData = ActiveWorkbook.Worksheets("Фрукты").Range(sAddress).Value 'получаем значение
    wb.Worksheets("Фрукты").UsedRange.Copy
    ws.Range("A1").PasteSpecial xlPasteValues  'вставляем значения
    ws.Range("A1").PasteSpecial xlPasteFormats 'вставляем форматы
    Application.CutCopyMode = False
    wb.Close False
    wsAct.Activate
    Application.ScreenUpdating = True 'Включаем обновление экрана
End Sub

Sub ВставляетЗначениеВыбор()
    Dim oFD As FileDialog
    Dim wb As Workbook, ws As Worksheet
    Dim path$
    Set oFD = Application.FileDialog(msoFileDialogFilePicker)
    With oFD
        .AllowMultiSelect = False
        .Title = "Выбрать файл"
        .Filters.Clear
        .Filters.Add "All files", "*.*"
        .InitialFileName = ActiveWorkbook.path
        .InitialView = msoFileDialogViewDetails
        If oFD.Show = 0 Then Exit Sub
    End With
    path = oFD.SelectedItems(1)
    Set ws = ActiveWorkbook.Worksheets("Фрукты") 'лист, куда переносить данные
    Set wb = Workbooks.Open(path)
    'sAddress = "A1:G100" 'или одна ячейка - "A1"
    'vData = ActiveWorkbook.Worksheets("Фрукты").Range(sAddress).Value 'получаем значение
    wb.Worksheets("Фрукты").UsedRange.Copy
    ws.Range("A1").PasteSpecial xlPasteValues  'вставляем значения
    ws.Range("A1").PasteSpecial xlPasteFormats 'вставляем форматы
    Application.CutCopyMode = False
    wb.Close False
    Application.ScreenUpdating = True 'Включаем обновление экрана
End Sub

Sub ВставляетЗначениеВыбор()
    Dim oFD As FileDialog
    Dim wb As Workbook, ws As Worksheet
    Dim path$
    Set oFD = Application.FileDialog(msoFileDialogFilePicker)
    With oFD
        .AllowMultiSelect = False
        .Title = "Выбрать файл"
        .Filters.Clear
        .Filters.Add "All files", "*.*"
        .InitialFileName = ActiveWorkbook.path
        .InitialView = msoFileDialogViewDetails
        If oFD.Show = 0 Then Exit Sub
    End With
    path = oFD.SelectedItems(1)
    Set ws = ActiveWorkbook.Worksheets("Фрукты") 'лист, куда переносить данные
    Set wb = Workbooks.Open(path)
    'sAddress = "A1:G100" 'или одна ячейка - "A1"
    'vData = ActiveWorkbook.Worksheets("Фрукты").Range(sAddress).Value 'получаем значение
    wb.ActiveSheet.UsedRange.Copy
    ws.Range("A1").PasteSpecial xlPasteValues  'вставляем значения
    ws.Range("A1").PasteSpecial xlPasteFormats 'вставляем форматы
    Application.CutCopyMode = False
    wb.Close False
    Application.ScreenUpdating = True 'Включаем обновление экрана
End Sub

            If oCntrl.Value = True Then
                select case oCntrl.Name
                case "CheckBox1"
                    Call Яблоко
                case "CheckBox2"
                    Call Груша
                case "CheckBox3"
                    Call Лимон
                End Select
            End If

Private Sub CommandButton1_Click()
    Dim oCntrl, s$
    For Each oCntrl In Me.Controls
        If TypeOf oCntrl Is MSForms.CheckBox Then
            If oCntrl.Value = True Then
                s = Replace(oCntrl.Name, "CheckBox", "")
                If Len(s) Then
                    Application.Run "Макрос" & s
                End If
            End If
        End If
    Next
End Sub