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

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

即

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 

macros运行时，它将在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 '~~> ie 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