Public Sub generateSeries()
    Dim pSheet As Worksheet
    Dim vOut(1 To 300000, 1 To 11) As Variant, i As Long, k As Long
    For i = 1 To 300000
        vOut(i, 1) = i
        vOut(i, 2) = 0.1 * Math.Rnd
        If (i Mod 10000) > 0 Then
            For k = 0 To (i Mod 3)
                vOut(i, 3 * k + 3) = "User " & CStr(Application.WorksheetFunction.RandBetween(11, 1111111))
                vOut(i, 3 * k + 4) = 1000 * Math.Rnd
                vOut(i, 3 * k + 5) = 10 * Math.Rnd
            Next k
        End If
    Next
    Set pSheet = ThisWorkbook.Worksheets.Add
    pSheet.Range("A2").Resize(300000, 11).Value = vOut
End Sub

let
    Source = Excel.CurrentWorkbook(){[Name="tbl"]}[Content],
    fn=(_)=>#table({"Покупатель","Цена","Стоимость"},List.RemoveMatchingItems(List.Split(List.Skip(Record.FieldValues(_),2),3),{{}})),
    #"Added Custom" = Table.AddColumn(Source, "tbl", each fn(_))[[Товар], [#"КОЛ-ВО"],[tbl]],
    #"Expanded {0}" = Table.ExpandTableColumn(#"Added Custom", "tbl", {"Покупатель", "Цена", "Стоимость"}),
    notNull = Table.SelectRows(#"Expanded {0}", each ([Покупатель] <> null)),
    allNotNull = Table.RenameColumns(Table.Distinct(notNull[[Товар]]), {"Товар", "id"}),
    skiped = Table.Join(Source[[Товар], [#"КОЛ-ВО"]], {"Товар"}, allNotNull, {"id"}, JoinKind.LeftAnti),
    result = notNull & skiped[[Товар], [#"КОЛ-ВО"]],
    #"Sorted Rows" = Table.Sort(result,{{"Товар", Order.Ascending}})
in
    #"Sorted Rows"

let
    Source = Excel.CurrentWorkbook(){[Name="tbl"]}[Content],
    colNames = Table.ColumnNames(Source),
    headNames = List.Range(colNames, 0, 2),
    standardTriple = {"Покупатель", "Цена", "Стоимость"},
    nameTriples = List.Split(List.Range(colNames, 2), 3),
    maker = List.Transform(nameTriples, (next) =>
    let
        nextSubTable = Table.SelectColumns(Source, headNames & next),
        toStandard = Table.RenameColumns(nextSubTable, List.Zip({next, standardTriple}))
    in
        Table.SelectRows(toStandard, each [Покупатель] <> null)
    ),
    notNull = Table.Combine(maker),
    allNotNull = Table.RenameColumns(Table.Distinct(notNull[[Товар]]), {"Товар", "id"}),
    skiped = Table.Join(Source[[Товар], [#"КОЛ-ВО"]], {"Товар"}, allNotNull, {"id"}, JoinKind.LeftAnti),
    result = notNull & skiped[[Товар], [#"КОЛ-ВО"]],
    #"Sorted Rows" = Table.Sort(result,{{"Товар", Order.Ascending}})
in
    #"Sorted Rows"

Option Explicit
Option Private Module
Dim colLeft&, colRight&
'====================================================================================================
Sub FILE_Change()
Dim x, arrLeft, arrRight, arr(), r&, c&, n&, p&, flag As Boolean

arrLeft = [_allLeft].Value2: colLeft = UBound(arrLeft, 2)
arrRight = [_allRight].Value2: colRight = UBound(arrRight, 2)

ReDim arr(1 To (colLeft + colRight), 1 To 10 * UBound(arrLeft, 1))

    For r = 1 To UBound(arrLeft, 1)
        n = n + 1
        flag = False
        Call CopyRow(r, arrLeft, n, arr)
        For c = 1 To colRight Step 4
            If Len(arrRight(r, c)) Then
                p = p + 1
                If flag Then
                    n = n + 1
                    Call CopyRow(r, arrLeft, n, arr)
                    Call CopyPeople(r, arrRight, n, arr, c)
                Else
                    flag = True
                    Call CopyPeople(r, arrRight, n, arr, c)
                End If
            End If
        Next c
    Next r

Application.ScreenUpdating = False

On Error Resume Next
[_changeFill].EntireRow.Delete
On Error GoTo 0

If p = 0 Then GoTo fin

shChange.ListObjects(1).ShowTotals = False
ReDim Preserve arr(1 To (colLeft + colRight), 1 To n)
shChange.Cells(2, 1).Resize(UBound(arr, 2), UBound(arr, 1)).Value2 = FILE_Array2xTranspose(arr)
shChange.ListObjects(1).ShowTotals = True

fin: Application.Calculate: Application.ScreenUpdating = True
If p = 0 Then Call FILE_MsgTimeWork("Списание не найдено…"): Exit Sub

Call FILE_MsgTimeWork("Найдено позиций списания: " & p & vbLf & "Таблица успешно преобразована!")
shChange.Select
End Sub
'----------------------------------------------------------------------------------------------------
Private Sub CopyRow(rFrom&, arrFrom, rWhere&, arrWhere())
Dim c&
    For c = 1 To colLeft
        arrWhere(c, rWhere) = arrFrom(rFrom, c)
    Next c
End Sub
'----------------------------------------------------------------------------------------------------
Private Sub CopyPeople(rFrom&, arrFrom, rWhere&, arrWhere(), ByVal colStart&)
Dim c&, cc&: cc = colLeft
    For c = colStart To colStart + 3
        cc = cc + 1: arrWhere(cc, rWhere) = arrFrom(rFrom, c)
    Next c
End Sub
'====================================================================================================
' следующие 2 находятся в другом модуле
'====================================================================================================
Function FILE_Array2xTranspose(arr2x) As Variant()
Dim arr(), r&, c&

ReDim arr(1 To UBound(arr2x, 2), 1 To UBound(arr2x, 1))
    For c = 1 To UBound(arr, 2)
        For r = 1 To UBound(arr, 1)
            arr(r, c) = arr2x(c, r)
        Next r
    Next c
FILE_Array2xTranspose = arr
End Function
'====================================================================================================
Sub FILE_MsgTimeWork(Optional ByVal txtHead$ = "")
If FFF_timer = 0 Then MsgBox "Не установлено начало отсчёта", vbCritical, "FILE_MsgTimeWork": Exit Sub
If Len(txtHead) Then txtHead = txtHead & vbLf & vbLf
MsgBox txtHead & "Время работы макроса: " & Format$(Timer - FFF_timer, "0.00 сек"), vbInformation, "ГОТОВО": FFF_timer = 0
End Sub
'====================================================================================================

// UnpivotRepeatedColumns
let
    functionCode = (sourceTable as table, startFixColumnCount as number, repeatColumnCount as number, optional repeatColumnNames as list) as any => 
    let
        constSuffix = try DateTime.ToText(DateTime.LocalNow(), "yyyyMMddhhmmss") & "_" otherwise null,
        tempNestedName = "Temp_0!1@2#3$4%5^6",
        nullList = {List.Repeat({null}, repeatColumnCount)},
        defaultRepeatNames = List.Transform({1..repeatColumnCount}, each "Column" & constSuffix & Text.From(_)),
        fixColumnNames = List.Range(Table.ColumnNames(sourceTable), 0, startFixColumnCount),
        transform = Table.AddColumn(sourceTable, tempNestedName, (rec) =>
        let
            fieldValues = Record.FieldValues(rec),
            repeatFields = List.Skip(fieldValues, startFixColumnCount),
            rows = List.Split(repeatFields, repeatColumnCount),
            notNullRows = List.RemoveMatchingItems(rows, nullList),
            toTable = #table(defaultRepeatNames, notNullRows)
        in
            toTable
        ),
        neededColumns = Table.SelectColumns(transform, fixColumnNames & {tempNestedName})
    in
        if repeatColumnNames = null then 
            Table.ExpandTableColumn(neededColumns, tempNestedName, defaultRepeatNames)
        else
            Table.ExpandTableColumn(neededColumns, tempNestedName, defaultRepeatNames, repeatColumnNames)
in
    functionCode

(sourceTable as table, 
 startFixColumnCount as number, 
 repeatColumnCount as number, 
 optional repeatColumnNames as list) as table => 

    let
        columnNames = List.Buffer(Table.ColumnNames(sourceTable)),
        tempNestedName = Text.NewGuid(),
        nullList = {List.Repeat({null}, repeatColumnCount)},
        defaultRepeatNames=List.Range(columnNames, startFixColumnCount, repeatColumnCount),
        fixColumnNames = List.Range(columnNames, 0, startFixColumnCount),
        transform = Table.AddColumn(
            sourceTable, 
            tempNestedName, 
            (rec) =>
                let
                    fieldValues = Record.FieldValues(rec),
                    repeatFields = List.Skip(fieldValues, startFixColumnCount),
                    rows = List.Split(repeatFields, repeatColumnCount),
                    notNullRows = List.RemoveMatchingItems(rows, nullList),
                    toTable = #table(defaultRepeatNames, notNullRows)
                in
                    toTable
            ),
        neededColumns = Table.SelectColumns(transform, fixColumnNames & {tempNestedName})
    in
        Table.ExpandTableColumn(
            neededColumns, 
            tempNestedName, 
            defaultRepeatNames, 
            if repeatColumnNames = null then defaultRepeatNames else repeatColumnNames)