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

VBA之神

我整个上午都在尝试调整业余VBA，在这种情况下，我是业余爱好者，可以随心所欲地表演

is现在所做的是：；在工作簿第三张工作表的O列中查找单元格值1。当点击时，它将O列中有1的行复制到名为Blad1的新工作表中。然后切换回工作簿Doorvoeren中的第三张工作表

它将按需要循环并执行任务，我唯一不能让它做的就是根据sheet Doorvoeren中的变量复制行。当这个值为5时，我希望它复制O列中有1的行，以及它下面的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

编辑：谢谢大家的回答，事实上很难找到一个有效的答案。再次解释；我需要对这个VBA进行调整，使其看起来像是表单Doorvoeren中的单元格Q3，以获得要复制的行数。所以，如果Q3是单元值；5，我想让它复制O列中的数字为1的行，在Sheet Doorvoeren中，以及它下面的其他四行

所以O列中的1只是一个标记，而不是我要复制的行数。

---

如果我不完全清楚，请询问/告诉我。

建议您避免使用Select和ActiveSheet，而使用引用的工作表和范围

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

---

下面是我的解决方案，它使用注释来修改代码

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

---

我对你的解释做了一点改动

'====================================================
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

---

希望这能更好地帮助您：

您好。您的Doorvoeren表中的变量是哪列？变量是否总是一个整数，表示它应该如何复制到它下面？例如，有1，其中只有一行需要复制，2，其中两行等。变量在表Doorvoeren Q3中，这始终是一个整数。当它达到1（每次都是我的标记）时，我希望它复制Q3中该值的行数。希望这会清除它。rowsr.resizeQ3值。copy@RobExcel试试下面我的答案中的代码，看看它是否如你所愿。谢谢你的快速回答@Shai Rado。编辑了一篇文章，试图在我的原始帖子中更好地解释我的问题。谢谢你的快速回答@Hadi。编辑了一篇文章，试图在我的原始帖子中更好地解释我的问题。如果你对此有任何问题，请告诉我。谢谢你的快速回答@Wilson88。做了一次编辑，试图在我的原始帖子中更好地解释我的问题，我认为你的代码最接近工作状态。没问题。关于您的编辑，我没有使用标记来定义要复制的行数，而是根据您原始帖子中的评论定义Q列中的值。Var=Cellsr，ColumnsQ.Column.Value。这不对吗？叮，叮，叮。我们赢了。很抱歉误解了威尔逊，这是问题的绝妙解决方案！不，你的代码完全符合我的要求。只是完全错了。我想我今天做VBA的时间太长了。@RobExcel你知道一直在工作表之间选择并不是最好的解决方案，对吗？