Private Sub Worksheet_Change(ByVal Target As Range)
    Dim d_ As Range
    Application.ScreenUpdating = 0
    r0_ = 5
    r1_ = Range("A" & Rows.Count).End(xlUp).Row
    c0_ = 2
    c1_ = Cells(r0_ - 1, Columns.Count).End(xlToLeft).Column
    Set d_ = Intersect(Target, Range(Cells(r0_, c0_), Cells(r1_, c1_)))
    If Not d_ Is Nothing Then
        dc_ = d_.Cells.Count
        With shIst
            r11_ = .Range("A" & Rows.Count).End(xlUp).Row
            For i = 1 To dc_
                .Range("A" & r11_ + i) = Cells(r0_ - 1, d_(i).Column).Value
                .Range("B" & r11_ + i) = Cells(d_(i).Row, c0_ - 1).Value
                .Range("C" & r11_ + i) = d_(i).Value
            Next i
        End With
    End If
End Sub

Private Sub Worksheet_Activate()
    Dim LastRefreshed As Date
    With Sheets("Лист3").PivotTables(1)
        LastRefreshed = .RefreshDate: .RefreshTable
        Do While .RefreshDate <= LastRefreshed
            DoEvents
        Loop
    End With
    Me.ListObjects(1).QueryTable.Refresh 0
End Sub

Private Sub Worksheet_Change(ByVal Target As Range) 'При каждом изменении на листе
    Dim d_ As Range 'договариваемся, что d_ будет обозначением ячеек
    Application.ScreenUpdating = 0 'отключаем автообновление экрана
    r0_ = 5 'начальная строка
    r1_ = Range("B" & Rows.Count).End(xlUp).Row 'конечная строка по столбцу В
    c0_ = 3 'начальный столбец
    c1_ = Cells(r0_ - 1, Columns.Count).End(xlToLeft).Column 'конечный столбец по строке r0_-1 (4 строка)
    f_ = "ФИО" 'где будем ловить изменения
    n_ = 3 'кол-во строк в блоке (часы, машина, ФИО)
    Set d_ = Intersect(Target, Range(Cells(r0_, c0_), Cells(r1_, c1_))) 'пересечение С5:AG16 и того диапазона,
    'где мы изменили данные обзываем "d_" (сделано для возможности вводить сразу несколько строк и/или столбцов - например, копи-паст)
    If Not d_ Is Nothing Then 'если не d = пусто (другими словами - если d не пусто)
        dc_ = d_.Cells.Count 'кол-во ячеек в d
        With shIst 'для листа с кодовым именем shIst. Теперь его имя не пишем, а обозначаем первой точкой, вот так - .Range(что-то
            r11_ = .Range("A" & Rows.Count).End(xlUp).Row 'конечная строка по столбцу А
            For i = 1 To dc_ 'i меняется от 1 до dc и для каждого из i
                If Cells(d_(i).Row, c0_ - 1) = f_ Then 'если в той же строке и столбце В значение f, то
                    ii = ii + 1 'к счетчику ii прибавляем 1
                    .Range("A" & r11_ + ii) = Cells(r0_ - 1, d_(i).Column).Value 'в первой пустой ячейке столбца А листа shIst
                    'вставляем значение из строки 4 того столбца, где изменение на Лист1
                    .Range("B" & r11_ + ii) = Cells(d_(i).Row - n_ + 1, c0_ - 2).Value 'в первой пустой ячейке столбца В листа shIst
                    'вставляем значение из столбца А [строки с изменением минус 2], где изменение на Лист1
                    .Range("C" & r11_ + ii) = d_(i).Value 'в первой пустой ячейке столбца С листа shIst
                    'вставляем изменяемое значение из Лист1
                End If 'окончание второго ЕСЛИ
            Next i 'i становится i+1
        End With 'заканчиваем With по листу shIst
    End If 'окончание первого ЕСЛИ
End Sub 'окончание макроса

If Cells(d_(i).Row, c0_ - 1) = f_ and d_(i)<>""  Then