Макрос, транслирующий исходный реестр в другой формат - VBA

Формулировка задачи:

Ребята все привет, дорогие мои помогите девочке, есть исходные реестр с привязкой к дате, мне надо транслировать в другой формат с привязкой к контрагентам. Как реализовать макросом? Примерчик с объяснениями приложила.

Решение задачи: «Макрос, транслирующий исходный реестр в другой формат»

textual
                            Листинг программы 
                        
 
                            
                        
Sub ReestrNew()
    Dim b(), i&, j&, k&
    nk = Array("1 d", "2", "3", "5 7 10 13 17 23", "4 8 12 14 18 22", "6 9 11 15 19 24", "20 25 d", "16 21")
    a = Sheets("Лист1").UsedRange.Value
    ReDim b(2 To UBound(a, 1), 1 To 8)
    For i = 2 To UBound(b, 1)
        For j = 1 To UBound(b, 2)
            s = Split(nk(j - 1))
            zn = ""
            For k = 0 To UBound(s)
                If IsNumeric(s(k)) Then
                    zn = zn & a(i, s(k))
                Else
                    If zn <> "" Then
                        d = Split(zn)
                        d(UBound(d)) = ""
                        zn = Join(d)
                    End If
                End If
            Next
            If zn = "" Then zn = " "
            If j = 6 Then zn = CDbl(zn)
            b(i, j) = zn 'IIf(j = 6, CDbl(zn), zn)
        Next
    Next
    With Sheets("Реестр")
        .Rows("2:" & .UsedRange.Rows.Count + 1).Delete
        .Cells(2, 1).Resize(UBound(b, 1) - 1, UBound(b, 2)) = b
    End With
    Sheets("Свод").Activate
    ActiveSheet.PivotTables("СводнаяТаблица1").PivotCache.Refresh
End Sub