根据单元格值复制/粘贴X次数

Question

我想复制整行并将值粘贴到另一个工作表中。

I.e.

1. 行1将头
2. 行2将包含数据要被复制
3. 行3同行2的上方
4. 反复向下。

在数据行内部会有一列M中的单元格，其中包含该数字可以为每行更改的数字，以便更改粘贴时间。

我想复制&将行中的全部数据（例如2）粘贴到显示在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 

唯一的问题是它只复制第4列。但我想要复制整个行。目前有16列，但未来可能会增长。

Answer 1

其实很简单。试试这个（UNTESTED）

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