VBA将x（可变）行复制到另一个工作表

VBA的神，

一直试图调整这一块业余VBA（在这种情况下，我是业余）来执行我想要的。

现在是什么呢？ 在我的工作簿的第三张表中的列O中查找单元格值1。 当它被击中时，它将列O中具有1的行复制到名为“Blad1”的新工作表中。 然后切换回工作簿“Doorvoeren”中的第三张表格。

它会循环和执行任务，只是我不能做到的事情是基于表中的variables“Doorvoeren”复制行。 当这个值是5时，我希望它复制1行O列中的行，以及它下面的4行。 （举例）。

你可以在这里把我正确的方向发给我吗？ 试图使其工作，但也在过程中学习。

我的代码被添加到下面的示例中：

Sub testIt() Dim r As Long, endRow As Long, pasteRowIndex As Long endRow = 500 pasteRowIndex = 5 For r = 3 To endRow If Cells(r, Columns("O").Column).Value = 1 Then Rows(r).Select Selection.Copy Sheets("Blad1").Select Rows(pasteRowIndex).Select ActiveSheet.Paste pasteRowIndex = pasteRowIndex + 1 Sheets("Doorvoeren").Select End If Next r End Sub 

编辑：谢谢大家的答案，实际上有真正的麻烦find一个工作。 再解释一下; 我需要这个VBA调整的方式，它看起来在单元格Q3，在“Doorvoeren”表中获取要复制的行数。 那么，如果Q3是单元格值， 5，我希望它复制在列O，在工作表“Doorvoeren”中的号码1的行，但也是在它下面的其他四行。

所以我在列0中的1，只是一个标记，而不是我想要复制的行数。 请问/告诉我，如果我不完全清楚。

Answer 1

这是我的解决scheme（稍微修改注释的代码）

 Sub testIt() 'add another variable (called var) Dim r As Long, endRow As Long, pasteRowIndex As Long, Var As Long endRow = 500 pasteRowIndex = 5 For r = 3 To endRow If Cells(r, Columns("O").Column).Value = 1 Then 'Grab the var number from the Doorvoeren sheet. Var will then determine how many rows need to be copied in each circumstance Sheets("Doorvoeren").Select Var = Cells(r, Columns("Q").Column).Value Rows(r & ":" & r + (Var - 1)).Select Selection.Copy Sheets("Blad1").Select Rows(pasteRowIndex).Select ActiveSheet.Paste pasteRowIndex = pasteRowIndex + Var Sheets("Doorvoeren").Select End If Next r End Sub 

Answer 2

如果避免使用Select和ActiveSheet ，build议使用引用的表格和范围。

 Option Explicit Sub testIt() Dim r As Long, endRow As Long, pasteRowIndex As Long Dim PasteRow As Long With Sheets("Doorvoeren") ' find last row with data in Column "O" in "Doorvoeren" sheet endRow = .Cells(.Rows.Count, "O").End(xlUp).Row For r = 3 To endRow If .Cells(r, "O").Value = 1 Then pasteRowIndex = 1 Else If .Cells(r, "O").Value = 5 Then pasteRowIndex = 5 End If End If ' find last row with data in Column "O" in "Blad1" sheet PasteRow = Sheets("Blad1").Cells(Sheets("Blad1").Rows.Count, "O").End(xlUp).Row ' copy number of rows from "Doorvoeren" sheet to "Blad1" sheet, paste them on the first empty row in "Blad1" sheet .Range("O" & r).Resize(pasteRowIndex).EntireRow.Copy Destination:=Sheets("Blad1").Range("A" & PasteRow + 1) Next r End With End Sub 

Answer 3

我对你的解释做了一些小改动。

 '==================================================== Sub testIt() Dim r As Long, endRow As Long, pasteRowIndex As Long Dim DestR as Range Dim Rloop as Range dim RowsCounter as Integer endRow = 500 pasteRowIndex = 5 RowsCounter = 0 For Each Rloop in Sheets("Doorvoeren").range("O3:O" & endRow) if Rloop = 1 and RowsCounter=0 then RowsCounter = Rloop.Offset(0, 2) If Rloop = 1 or RowsCounter > 0 Then Set DestR = Sheets("Blad1").range("A" & pasteRowIndex) Rloop.EntireRow.Copy DestR pasteRowIndex = pasteRowIndex + 1 RowsCounter = RowsCounter - 1 End If Next Rloop End Sub 

希望这有助于更好:)