Автоматически создать необходимое кол-во строк согласно указанному в ячейке

[lioon]

Вопрос 1:
Есть список файлов, который формируется в таблице, в названии файла есть цифра, показывающая количество листов в файле, необходимо вставить после каждой строчки с цифрой пустые строки равные цифре из строчки - 1 (см. пример)

Вопрос 2:
Как автоматически заполнить таблицу (см. пример лист "Исходный" Лист "Пример заполнения")

Спасибо. Очень поможет облегчить работу.

[lioon]

Возможно сложно сформулировал предыдущую задачу.
Попробовал упростить до минимума.
Важна идея, не могу сообразить как сделать.

[Hugo121]

Да в общем ничего сложного. И способов это реализовать макросом куча...
Но вот проблема - что как там на месте по факту из постановки задачи не понятно, поэтому практически делать как-то бестолково. Сделаешь - а зря, т.к. применять нельзя или неудобно.
Вот например сделать в этом примере кнопку с макросом, который делает из конкретного диапазона A3:B7 конкретный диапазон D13:E24 легко. Но ведь бестолково...

[IgorGO]

Sub AddRows()
  Dim r As Long
  For r = Cells(Rows.Count, 2).End(xlUp).Row To 3 Step -1
    If Cells(r, 2) > 1 And IsNumeric(Cells(r, 2)) Then
      Rows(r).Copy:  Cells(r + 1, 1).Resize(Cells(r, 2) - 1, 1).EntireRow.Insert
      Cells(r + 1, 1).Resize(Cells(r, 2) - 1, 1).ClearContents
    End If
  Next
End Sub

[Hugo121]

Option Explicit

Sub tt()
    Dim r As Range, a(), i&, ii&, x&

    Set r = [A3:B7]
    a = r.Value
    ReDim b(1 To Application.Sum(r.Columns(2)) + 1, 1 To 2)
    b(1, 2) = a(1, 2): x = 2
    For i = 2 To UBound(a)
        b(x, 1) = a(i, 1): b(x, 2) = a(i, 2)
        For ii = 1 To a(i, 2)
            b(x, 2) = a(i, 2): x = x + 1
        Next
    Next
    With [D13].Resize(UBound(b), 2)
        .Value = b
        .Borders.Weight = xlThin
    End With
End Sub

[IgorGO]

Игорь, ни для кого здесь не секрет, что мы с тобой плохие экстрасенсы.

Но даже среди двух плохих экстрасенсов можно выявить "лучшего". Сейчас ТС определит)))

[Hugo121]

Я думаю что победит дружба
Т.е. не применим ни один вариант.

Я так вообще всё делал по примеру. Но с прицелом на доработку двумя инпутбоксами типа 8

[lioon]

Спасибо! Вы хорошие экстрасенсы.
После небольшой доработки кода IgorGO:

Sub AddRows()
Dim r As Long
For r = Cells(Rows.Count, 3).End(xlUp).Row To 3 Step -1
If Cells(r, 3) > 1 And IsNumeric(Cells(r, 3)) Then
Rows(r).Copy: Cells(r, 3).Resize(Cells(r, 3) - 1, 3).EntireRow.Insert
Cells(r, 3).Resize(Cells(r, 3), 3).ClearContents
End If
Next
End Sub

получил то чего добивался. Спасибо!