Option Explicit

Sub кол()
    Dim a(), i&, x&, t$, col As New Collection
    Dim dic As Object, arr

    Set dic = CreateObject("scripting.dictionary")
    arr = Split("количество сумма")
    With dic
        .comparemode = 1

        a = Sheets("данные").Range("A1").CurrentRegion.Value

        On Error Resume Next
        For i = 2 To UBound(a)
            col.Add a(i, 1), Trim(a(i, 1))
            For x = 0 To UBound(arr)
                t = a(i, 1) & "|" & a(i, 4) & "|" & arr(x)
                .Item(t) = .Item(t) + a(i, x + 2)
            Next
        Next
        On Error GoTo 0

        For x = 0 To UBound(arr)
            подпроцедура arr(x), col, dic
        Next

    End With
End Sub

Private Sub подпроцедура(лист, col, dic As Object)
    Dim a, b, i&, ii&, t$

    With Sheets(лист).Range("A5").CurrentRegion
        .Rows(3).Resize(.Rows.Count - 2).ClearContents
    End With

    a = Sheets(лист).Range("A5").CurrentRegion.Rows(1).Resize(2).Value
    ReDim b(1 To col.Count, 1 To 6)
    For i = 1 To col.Count
        b(i, 1) = col(i)
        For ii = 2 To UBound(a, 2)
            t = b(i, 1) & "|" & a(2, ii) & "|" & a(1, ii)
            If dic.exists(t) Then b(i, ii) = dic.Item(t)
        Next
    Next
    Sheets(лист).Range("A6").Resize(UBound(b), UBound(b, 2)) = b

End Sub