ДВССЫЛ(НАЧАЛОСТРОКИ(ПСТР(ЯЧЕЙКА("filename";A2);ПОИСК("]";ЯЧЕЙКА("filename";A2))+1;31);"Смена")&"!E7")

СУММПРОИЗВ(A11:A160;M11:M160)/СУММ(A11:A160) 

Sub NoFormula() ' поиск где нет формулы
Dim iSh As Worksheet
Dim iCl As Range
Dim iStr$
For Each iSh In Worksheets
    If iSh.Name Like "*Смена*" Then  'Смена*
        For Each iCl In iSh.Range("H11:J129").Cells
            If iCl.HasFormula = False Then
                If IsEmpty(iStr) Then
                    iStr = "Лист - " & iSh.Name & ", ячейка - " & iCl.Address(0, 0) & vbCrLf
                Else
                    iStr = iStr & "Лист - " & iSh.Name & ", ячейка - " & iCl.Address(0, 0) & vbCrLf
                End If
            End If
        Next
    End If
Next
MsgBox iStr
End Sub

Private Sub Кнопка37_Щелчок() 
'Водители 
  On Error GoTo ErrorHandler   
  Dim arr() 
  Dim c As Range, i& 
  i = -1     
  For Each c In Sheets("График").Range("G5:AS5").Cells         
    If Trim(c) <> "" Then           
      i = i + 1             
      ReDim Preserve arr(i)             
      arr(i) = Trim(c)         
    End If     
  Next Worksheets(arr).Select
  
GoTo Ends:
 
ErrorHandler:   
MsgBox ("В списке есть водитель которого нет в базе") ' Добавить значение не найденного листа 
Ends:  
End Sub 

Private Sub Worksheet_Activate()
    Dim LastRow As Long
    With ActiveSheet
     LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
    End With
    MsgBox LastRow
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    With Target
        If .Count < 3 Then Call CC(Target)
        If .Count < 3 Then Exit Sub
            On Error Resume Next
            If CDate(.Value) Then
                Select Case .Column
                Case 1
                        Call bb
                End Select
        End If
    End With
End Sub

Sub CC()(Target As Range)
Dim NewCellValue$, OldComment$
Dim cell As Range
 On Error Resume Next
    'если ячейка не в отслеживаемом диапазоне, то выходим
     If Intersect(Target, Range("K7,Q7,AF7")) Is Nothing Then Exit Sub

    'перебираем все ячейки в измененной области
    For Each cell In Intersect(Target, Range("K7,Q7,AF7"))

If Target.HasFormula = False Then cell.Comment.Delete
If Target.HasFormula = False Then Exit Sub

            NewCellValue = cell.Formula     'или ее содержимое

        With cell
            .Comment.Delete     'удаляем старое примечание (если было)
            .AddComment         'добавляем новое и вводим в него текст
            .Comment.Text Text:=NewCellValue

            .Comment.Shape.TextFrame.AutoSize = True    'делаем автоподбор размера
            .Comment.Shape.TextFrame.Characters.Font.Size = 8
        End With
    Next cell
End Sub