Sub mrshkei()
Dim arr, arr2, arr3, i As Long, lr As Long, sh As Worksheet, col As New Collection
For Each sh In Worksheets
    lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
    arr = sh.Range("a5:f" & lr)
    For i = LBound(arr) To UBound(arr)
        If arr(i, 1) <> Empty Then
            On Error Resume Next
            col.Add (arr(i, 1) & "::" & arr(i, 2) & "::" & arr(i, 3) & "::" & arr(i, 5) & "::" & arr(i, 6)), _
            CStr(arr(i, 1) & "::" & arr(i, 2) & "::" & arr(i, 3) & "::" & arr(i, 5) & "::" & arr(i, 6))
        End If
    Next i
    ReDim arr2(1 To col.Count, 1 To 6)
    For i = 1 To col.Count
    arr3 = Split(col(i), "::")
        arr2(i, 1) = arr3(0)
        arr2(i, 2) = arr3(1)
        arr2(i, 3) = arr3(2)
        arr2(i, 5) = arr3(3)
        arr2(i, 6) = arr3(4)
        arr2(i, 4) = Application.WorksheetFunction.SumIfs(sh.Columns(4), sh.Columns(1), arr2(i, 1), sh.Columns(2), arr2(i, 2), sh.Columns(3), arr2(i, 3), sh.Columns(5), arr2(i, 5), sh.Columns(6), arr2(i, 6))
    Next i
    sh.Range("A5:F" & lr + 2).ClearContents
    sh.Range("A5").Resize(UBound(arr2), 6) = arr2
    Set col = Nothing
Next sh
End Sub