Excel VBA – 重复的行

我需要复制一个充满公式N次的行。 N由不同纸张上的行数定义。 公式是每行唯一的，但我认为自动填充将处理。

在“DestSheet”：第1行是一个标题第2行有我要复制“Cnt”次，从第3行开始的行。第2行有单元格是行唯一的 – =凭证！C2我需要第2行是与第2行相同，但增加了行号这样，我得到=第3行上的Credledge！C3和= Credentials！第4行上的C4（其他公式更复杂 – 但遵循相同的模型）当函数完成后，“DestSheet “将会有第2行开始的”Cnt“行

我接近我在这个网站上find的代码…..

Sub AddRows(Cnt As Integer, DestName As String) Dim DestSheet As Worksheet Dim i As Integer Set DestSheet = Worksheets(DestName) For i = 1 To Cnt Sheets(DestName).cell(i + 2, 1).AutoFill _ Destination:=Range(LastRow) Next i End Sub ' AddRows 

Answer 1

您不需要循环自动填充：

 Sub AddRows(Cnt As Integer, DestName As String) Dim DestSheet As Worksheet Set DestSheet = Worksheets(DestName) DestSheet.Cells(2, 1).AutoFill _ Destination:=DestSheet.Cells(2, 1).Resize(Cnt) End Sub 

以上将填充A2到CNT中的行数。 如果你想填满整个第2行，使用这个。

 Sub AddRows(Cnt As Integer, DestName As String) Dim DestSheet As Worksheet Set DestSheet = Worksheets(DestName) Dim colcnt As Long With DestSheet colcnt = .Cells(2, .Columns.Count).End(xlToLeft).Column .Range(.Cells(2, 1), .Cells(2, colcnt)).AutoFill _ Destination:=.Range(.Cells(2, 1), .Cells(2, colcnt)).Resize(Cnt) End With End Sub 

AS ZygD解释说，由于Sub行中的variables，它不能自行运行，所以必须调用它。

 Sub CallAddRows() Dim rwcnt as integer dim DestShtNme as String rwcnt = 20 DestShtNme = "Sheet1" 'Change to your sheet. AddRows rwcnt, DestShtNme End Sub 

我在你的代码中假设你正在遍历各种表单，并调用这个子表单来发送添加行。 以上只是一个例子。 如何将两个variables传递给AddRows子项由您决定。 重要的部分是variables传递给子。

Answer 2

这就是我想到的：

 sub x() NbrRows = Sheets(SrcName).Range("A" & Rows.Count).End(xlUp).Row ' get the number of rows on the sheet to know how many rows to add to the dest sheet If NbrRows > 1 Then Call AddRows(NbrRows, DestName) End If end sub Sub AddRows(Cnt As Integer, DestName As String) Dim DestSheet As Worksheet Dim Dest As String Set DestSheet = Worksheets(DestName) ' DestSheet.Activate Dest = "3:" & Cnt Sheets(DestName).Rows("2:2").Select Selection.Copy Sheets(DestName).Rows(Dest).Select Sheets(DestName).Paste Sheets(DestName).Range("A2").Select Application.CutCopyMode = False 

End Sub'AddRows