Скопируйте и вставьте строки x раз, если x = "значение ячейки"

Question

скопируйте строки x-раз и вставьте в новый лист x-количество строк.Затем измените значение ячейки Col "S" на "1 из x", "2 из x", "3 из x" .... "x of x".

"Sheet1" Col "S" содержит x-числовое значение.Скопируйте столбцы «B» - «AJ» в каждой строке со значением и вставьте в «sheet3».

Я использовал некоторый код, обнаруженный в переполнении стека в « Копировать строку X, количество раз на основе значения ячейки », но мне нужно изменить значение «S» в каждой добавленной строке.

Sub Sample()
Dim wsI As Worksheet, wsO As Worksheet
Dim lRow_I As Long, lRow_O As Long, i As Long, j As Long

'~~> Set your input and output sheets
Set wsI = ThisWorkbook.Sheets("Sheet1")
Set wsO = ThisWorkbook.Sheets("Sheet3")

'~~> Output row
lRow_O = wsO.Range("B" & wsO.Rows.Count).End(xlUp).Row + 1

With wsI
    '~~> Get last row of input sheet
    lRow_I = .Range("B" & .Rows.Count).End(xlUp).Row

    '~~> Loop through the rows
    For i = 2 To lRow_I
        '~~> This will loop the number of time required
        '~~> i.e the number present in cell S
        For j = 1 To Val(Trim(.Range("S" & i).Value))
            '~~> This copies
            .Rows(i).Copy wsO.Rows(lRow_O)
            '~~> Get the next output row
            lRow_O = wsO.Range("B" & wsO.Rows.Count).End(xlUp).Row + 1
        Next j
    Next i
End With
End Sub

Я ожидаю, что каждая строка на листе 1 будет находиться на листе 3, сколько раз ячейка "S" ("S" = цифра от 1 до 15) в значении этой строки равна.Тогда каждая добавленная новая строка будет иметь значение «S», «1 из S», «2 из S» и т. Д. До «S из S».

Answer 1

Sub Sample()

    Dim wsI As Worksheet, wsO As Worksheet
    Dim lRow_I As Long, lRow_O As Long, i As Long, j As Long
    Dim rw As Range, n As Long

    Set wsI = ThisWorkbook.Sheets("Sheet1")
    Set wsO = ThisWorkbook.Sheets("Sheet3")

    lRow_O = wsO.Range("B" & wsO.Rows.Count).End(xlUp).Row + 1
    lRow_I = wsI.Range("B" & wsI.Rows.Count).End(xlUp).Row

    For i = 2 To lRow_I

        Set rw = wsI.Rows(i)
        n = Val(Trim(rw.Range("S1").Value))

        rw.Copy wsO.Rows(lRow_O).Resize(n) 'makes n copies of the row

        'add the "x of n" values
        wsO.Cells(lRow_O, "S").Resize(n, 1).Value = Evaluate("=ROW(1:" & n & ") & "" of " & n & """")

        'or alternatively / less complex...
        for j = 1 to n
            wsO.Cells(lRow_O, "S").Offset(j-1, 0).Value = j & " of " & n
        next j

        lRow_O = lRow_O + n

    Next i

End Sub