Sub reFormat()
    Dim sh As Worksheet, shd As Worksheet, cell As Range, dest As Range, fil As String
     
    Set shd = ThisWorkbook.Worksheets("Result")
    shd.UsedRange.Rows.Delete
    shd.[a1].Resize(1, 3) = Array("Филиал", "Номенклатура", "Кредит")
    Set dest = shd.[a2]
     
    Set sh = ThisWorkbook.Worksheets("TDSheet")
    fil = ""
    For Each cell In sh.UsedRange.Columns(1).Cells
        If cell.EntireRow.OutlineLevel = 2 Then fil = cell.Value
        If cell.EntireRow.OutlineLevel = 3 Then
            dest.Resize(1, 3).Value = Array(fil, cell.Value, cell.Offset(, 5).Value)
            Set dest = dest.Offset(1)
        End If
        Set cell = cell.Offset(1)
    Next
    shd.Activate
End Sub

Sub Test()
Dim Value, Name, Jan, i As Integer, nr As Integer

nr = Worksheets("Sheet2").Cells.SpecialCells(xlLastCell).Row 

Name= "A:A"
Jan = "B:B"

For i = 2 To nr
Value = Worksheets("Sheet2").Range("A" & i)
Range("B" & i) = WorksheetFunction.SumIf(Worksheets("Sheet1").Range(Name), Value, Worksheets("Sheet1").Range(Jan))
Next i
End Sub