Option Explicit

Sub test()
    Dim a, i As Long, ii As Long, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    a = Sheets("sheet1").Cells(1).CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 2 To UBound(a, 1)
            If Not dic.Exists(a(i, 1)) Then dic(a(i, 2)) = dic.Count + 2
            If Not .Exists(a(i, 1)) Then
                Set .Item(a(i, 1)) = CreateObject("Scripting.Dictionary")
                .Item(a(i, 1)).CompareMode = 1
            End If
            .Item(a(i, 1))(a(i, 2)) = .Item(a(i, 1))(a(i, 2)) + a(i, 3)
        Next
        ReDim a(1 To .Count + 1, 1 To dic.Count + 1)
        a(1, 1) = Sheets("sheet1").[a1]
        For i = 0 To dic.Count - 1
            a(1, i + 2) = dic.Keys()(i)
        Next
        For i = 0 To .Count - 1
            a(i + 2, 1) = .Keys()(i)
            For ii = 2 To UBound(a, 2)
                a(i + 2, ii) = .items()(i)(a(1, ii)) + 0
            Next
        Next
    End With
    With Sheets("sheet3").Cells(1).Resize(UBound(a, 1), UBound(a, 2))
        .EntireColumn.ClearContents
        Sheets("sheet1").[a1].Copy .Rows(1)
        .Value = a: .Columns.AutoFit: .Parent.Activate
    End With
End Sub

Option Explicit

Sub Sample()
    Dim ws As Worksheet, wsNew As Worksheet
    Dim tempArray As Variant, OutputAr() As Variant
    Dim officeCol As New Collection
    Dim productCol As New Collection
    Dim itm As Variant
    Dim lrow As Long, lcol As Long, totalsum As Long
    Dim i As Long, j As Long, k As Long

    '~~> Input sheet
    Set ws = Sheet1

    With ws
        '~~> Get Last Row and last column
        lrow = .Range("A" & .Rows.Count).End(xlUp).Row
        lcol = .Cells(1, Columns.Count).End(xlToLeft).Column

        '~~> Store it in a temp array
        tempArray = .Range(.Cells(2, 1), .Cells(lrow, lcol)).Value

        '~~> Create a unique collection using On error resume next
        On Error Resume Next
        For i = LBound(tempArray) To UBound(tempArray)
            officeCol.Add tempArray(i, 1), CStr(tempArray(i, 1))
            productCol.Add tempArray(i, 2), CStr(tempArray(i, 2))
        Next i
        On Error GoTo 0
    End With

    '~~> Define you new array which will hold the desired output
    ReDim OutputAr(1 To officeCol.Count + 1, 1 To productCol.Count + 1)

    '~~> Store the rows and columns in the array
    i = 2
    For Each itm In officeCol
        OutputAr(i, 1) = itm
        i = i + 1
    Next itm
    i = 2
    For Each itm In productCol
        OutputAr(1, i) = itm
        i = i + 1
    Next itm

    '~~> Calculate sum by comparing the arrays
    For i = 2 To officeCol.Count + 1
        For j = 2 To productCol.Count + 1
            totalsum = 0
            For k = LBound(tempArray) To UBound(tempArray)
                If OutputAr(i, 1) = tempArray(k, 1) And _
                   OutputAr(1, j) = tempArray(k, 2) Then
                   totalsum = totalsum + tempArray(k, 3)
                End If
            Next k

            OutputAr(i, j) = totalsum
        Next j
    Next i

    '~~> Create a new sheet
    Set wsNew = ThisWorkbook.Sheets.Add

    '~~> Outout the array
    wsNew.Range("A1").Resize(officeCol.Count + 1, productCol.Count + 1).Value = OutputAr
End Sub