我想复制整行并将值粘贴到另一个工作表中 .
即
-
第1行将是 Headers
-
第2行将包含要复制的数据
-
第3行与上面的第2行相同
-
重复下来 .
在数据行中, M
列中的单元格将包含一个数字,该数字可以为每一行更改,因此这将更改粘贴时间 .
我想用M2中显示的数字复制并粘贴行中的完整数据,比如2 . 如果 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列,但未来可能会增长 .
1 回答
实际上它非常简单 . 试试这个( UNTESTED )