Option Explicit

Sub tt()
    Dim a, i&, t$
    a = ActiveSheet.UsedRange.Columns(1).Resize(, 3).Value
    With CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(a)
            If Len(a(i, 2)) = 0 Then t = a(i, 1)
            .Item(t & "d" & a(i, 1)) = .Item(t & "d" & a(i, 1)) + a(i, 2)
            .Item(t & "c" & a(i, 1)) = .Item(t & "c" & a(i, 1)) + a(i, 3)
        Next

        a = [i3].CurrentRegion.Value
        For i = 2 To UBound(a)
            a(i, 2) = .Item(a(i, 1) & "d510101") + .Item(a(i, 1) & "d510102") + .Item(a(i, 1) & "d510103")
            a(i, 3) = .Item(a(i, 1) & "c510101") + .Item(a(i, 1) & "c510102") + .Item(a(i, 1) & "c510103")
        Next
        [i3].CurrentRegion.Value = a
    End With
End Sub

sheets("имя листа").[i3]

let
    from = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content],
    group = Table.Group(from, "Название", {"tmp", each _},GroupKind.Local,(x,y)=>Number.From(y=null))[tmp],
    f1=(t)=>Table.SelectRows(t,each [Название]<>null),
    f2=(t)=>Table.SelectRows(t,each List.ContainsAny({Text.From([Название])},{"510101","510102","510103"})),
    lst = List.Transform(group,each [a=f1(_){0},b= try f2(_){0} [[Дебет],[Кредит]] otherwise [Дебет=null,Кредит=null],c=a&b][c]),
    to=Table.FromRecords(lst)
in
    to

Sub tt()
    Dim a, el, i&, t$
    
    a = ActiveSheet.UsedRange.Columns(1).Resize(, 3).Value
    
    With CreateObject("Scripting.Dictionary")
        For Each el In Array(510101, 510102, 510103)
            .Item(el) = 0&
        Next
        For i = 2 To UBound(a)
            If Len(a(i, 2)) = 0 Then t = a(i, 1)
            If .exists(a(i, 1)) Then
                .Item(t & "d") = a(i, 2)
                .Item(t & "c") = a(i, 3)
            End If
        Next

        a = [i3].CurrentRegion.Value
        For i = 2 To UBound(a)
            a(i, 2) = .Item(a(i, 1) & "d")
            a(i, 3) = .Item(a(i, 1) & "c")
        Next
        [i3].CurrentRegion.Value = a
    End With
End Sub