Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("D1")) Is Nothing Then
    Dim sh As Worksheet, lr As Long, lcol As Long, i As Long, n As Long, lr2 As Long
    Set sh = Worksheets(Range("D1").Value)
    With sh
    lr = .Cells(Rows.Count, 1).End(xlUp).Row
    lcol = .Cells(1, Columns.Count).End(xlToLeft).Column
    lr2 = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 3 To lr2
    Parf = Cells(i, 1)
    Cod = Cells(i, 2)
        For n = 4 To 6
        Select Case n: Case Is = 4: x = 3: Case Is = 5: x = 4: Case Is = 6: x = 6: End Select ' ВСЕ КАК ЗАВЕЩАЛ ДЖЕК)
            xxx = Mid(Cells(i, 1), 1, InStr(Cells(i, 1), " ") - 1)
            Cells(i, n) = Application.WorksheetFunction.SumIfs(.Range(.Cells(x, 2), .Cells(x, lcol)), _
            .Range(.Cells(2, 2), .Cells(2, lcol)), Cells(i, 2), _
            .Range(.Cells(1, 2), .Cells(1, lcol)), xxx)
        Next n
    Next i
    End With
End If
End Sub