根據單元格值復制/粘貼X次

Question

我想復制整行並將值粘貼到另一個工作表中。

即

1. 第1行將是標題
2. 第2行將包含要復制的數據
3. 第3行與上述第2行相同
4. 反復下來。

在數據行中， M列中將有一個單元格，其中包含一個數字，該數字可以針對每一行更改，因此這將更改粘貼時間。

我想按M2中顯示的數字將完整數據復制並粘貼到第二行中。 如果M2有4則Sheet1的第2行被復制到工作表2上，四次一遍。

工作表1包含16列數據，如下所示

Aa Bb Cc Dd Ee Ff Gg Hh Ii Gg Kk Ll **4** Nn Oo Pp

運行宏時，在Sheet2中看起來像這樣

Aa Bb Cc Dd Ee Ff Gg Hh Ii Gg Kk Ll **4** Nn Oo Pp<br>
Aa Bb Cc Dd Ee Ff Gg Hh Ii Gg Kk Ll **4** Nn Oo Pp<br>
Aa Bb Cc Dd Ee Ff Gg Hh Ii Gg Kk Ll **4** Nn Oo Pp<br>
Aa Bb Cc Dd Ee Ff Gg Hh Ii Gg Kk Ll **4** Nn Oo Pp<br>

這就是我所擁有的

Sub CopyRowsXTimes()
    Dim rngCell As Range

    ThisWorkbook.Worksheets("Sheet2").Cells.ClearContents
    For Each rngCell In ThisWorkbook.Worksheets("Sheet1").Range("N2:N" & _
    Cells(Rows.Count, 14).End(xlUp).Row)
        With ThisWorkbook.Worksheets("Sheet2")
            .Cells(.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1, _
            1).Resize(rngCell.Value, 5).Value = rngCell.Offset(, -3).Resize(1, 5).Value
        End With
    Next rngCell

    Set rngCell = Nothing
End Sub

唯一的問題是它僅復制第1 4列。 但是我要復制整個行。 目前有16列，但將來可能會增加。

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

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

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

    With wsI
        '~~> Get last row of input sheet
        lRow_I = .Range("A" & .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 M
            For j = 1 To Val(Trim(.Range("M" & i).Value))
                '~~> This copies
                .Rows(i).Copy wsO.Rows(lRow_O)
                '~~> Get the next output row
                lRow_O = wsO.Range("A" & wsO.Rows.Count).End(xlUp).Row + 1
            Next j
        Next i
    End With
End Sub