Sub Export22()
Dim m, y(), t$, r&
Dim res(), k2&, k1&, rw&

m = Range("приемка_tb").Value
ReDim y(1 To UBound(m), 1 To 5)    'Таблица2: для листа Вывод2
ReDim res(1 To UBound(m), 1 To 5)    'Таблица1: для листа Вывод1

With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For r = 1 To UBound(m)
        t = m(r, 1) & "~" & m(r, 2) & "~" & m(r, 3)  'для второй таблицы на листе Вывод2
        If .Exists(t) Then
            rw = .Item(t)
            y(rw, 5) = y(rw, 5) + m(r, 4)  'amount
        Else
            k2 = k2 + 1: .Item(t) = k2
            y(k2, 1) = m(r, 1)    'box
            y(k2, 2) = m(r, 2)   'invoice
            y(k2, 3) = m(r, 3)    'delivery
            y(k2, 4) = m(r, 5)    'brend
            y(k2, 5) = m(r, 4)    'amount
        End If

        t = m(r, 2) & "~" & m(r, 3)  'для первой таблицы на листе Вывод1
        If .Exists(t) Then
            rw = .Item(t)
            If InStr(res(rw, 4), m(r, 1)) = 0 Then res(rw, 4) = res(rw, 4) & "~" & m(r, 1)    'box
            res(rw, 5) = res(rw, 5) + m(r, 4)  'amount
        Else
            k1 = k1 + 1: .Item(t) = k1
            res(k1, 1) = m(r, 2)    'invoice
            res(k1, 2) = m(r, 3)   'delivery
            res(k1, 3) = m(r, 5)    'brend
            res(k1, 4) = m(r, 1)    'box
            res(k1, 5) = m(r, 4)    'amount
        End If
    Next r
End With

For r = 1 To k1
    m = Split(res(r, 4), "~")
    If Not IsArray(m) Then res(r, 4) = 1 Else res(r, 4) = UBound(m) + 1
Next r
'здесь можно заморочиться с ListObject
Sheets("Вывод2").Range("A3").Resize(k2, UBound(y, 2)).Value = y
Sheets("Вывод1").Range("A3").Resize(k1, UBound(res, 2)).Value = res
End Sub