Option Explicit

Sub tt()
     Dim a(), i&, ii&, t$, k, sh As Object

     a = Sheets("Данные").UsedRange.Value

     Application.ScreenUpdating = False
     With CreateObject("scripting.dictionary"): .comparemode = 1
         For i = 2 To UBound(a)
             For ii = 1 To UBound(a, 2) Step 6
                 If a(i, ii + 5) > 0 Then
                     t = a(i, ii) & "|" & a(i, ii + 1) & "|" & a(i, ii + 2) & "|" & a(i, ii + 3) & "|" & a(i, ii + 4)
                     .Item(t) = .Item(t) + a(i, ii + 5)
                 End If
             Next
         Next

         Set sh = Workbooks.Add(1).Sheets(1)
         i = 1
         sh.Cells(i, 1).Resize(, 6) = Split("КОД1|КОД|Категория|Год-Месяц|Статья|Стоимость", "|")
         For Each k In .keys
             i = i + 1
             sh.Cells(i, 1).Resize(, 5) = Split(k, "|")
             sh.Cells(i, 6) = .Item(k)
         Next
     End With
     Application.ScreenUpdating = True
End Sub