Excel 循环代码的一部分，直到到达变量

有人能帮我吗？我需要循环以下代码，一旦“Calendario”工作表的D列中的一个单元格为空，这些代码就会停止。单元格计数应从D8开始，而不是在D8之前

变量如下： 第一次“复制”每次更改1行，“粘贴”每次必须为+52行 第二个“复制”是静态的，“粘贴”必须每次+52行 第三次“复制”每次更改1行，“粘贴”每次必须为+52行

我在下面所做的是有效的，我可以重复200次，但这样做既不干净也不健康，哈哈

第一次玩VBA，我正在学习

非常感谢任何能帮忙的人

---

---

我认为这应该给你一个好的开始，你想做什么：

Sub LoopingForDummies()
    Dim r As Range
    Dim i As Long

    ' The with-statement says that while we are inside the block, we are working on that object, saving us from having to type in that part of the address
    With ThisWorkbook.Sheets("Calendario")
        ' Set the range we are gonna loop over, the latter part of the range statements says that we go to the last cell in column D in which there is no data
        Set r = .Range(.Range("D8"), .Range("D" & .Rows.Count).End(xlUp))

        ' Loop over each cell in the range
        For i = 1 To r.Count
            ' Exit out of the sub if the cell is blank
            ' r.Cells(1, 1) = D8, r.Cells(2, 1) = D9, etc
            If IsEmpty(r.Cells(i, 1)) Then
                Exit Sub
            ' If not execute the code for that row
            ' D8 offset by 0,1 = E8, D8 offset by 0,3 = G8, etc
            ' A2 offset by 52,0 = A54
            Else
                .Range(r.Cells(i, 1).Offset(0, 1), r.Cells(i, 1).Offset(0, 3)).Copy _
                                    Destination:=Sheets("Export").Range("A2:C53").Offset(52 * (i - 1), 0)
            End If
        Next i
    End With
End Sub

我试图解释评论中发生了什么，但是如果你觉得有什么不清楚的地方，请随意在我的答案上发表评论

---

我不能保证这段代码做了您想要的一切——例如，如果您在问题中显示的内容之后执行了代码，您可能需要一种不同于我上面显示的方法来打破循环。

首先：谢谢！这对第一部分的循环非常有效。我现在正在尝试扩展它，因为我必须让它在其他两个都需要转置的问题上工作。再次感谢你善良的陌生人@Ginzo如果这解决了您的问题，您可以通过单击投票按钮下方的复选标记将其标记为解决方案。你也可以通过点击向上箭头向上投票，尽管我认为可能有代表要求这样做。只是部分遗憾。它确实向我解释了循环是如何工作的，我再次为此感谢你。。。遗憾的是，我努力尝试将另外两个拷贝/粘贴放入循环中，但没有实际结果。。。。我似乎不够胜任。我回到了生成200'行1'行2等的原始想法：'（但是…至少第一部分是循环的！：D@ginzo类似于

工作表（“Calendario”）.Range（“O7:BN7”）。复制工作表（“导出”）.Range（“D2”）。偏移量（52*（i-1），0）.Paste特殊粘贴：=xlPasteAll，操作：=xlNone，SkipBlanks:=False，转置：=True

不起作用？不起作用，但我终于成功了！！！非常感谢您的初始代码！！！

Sub LoopingForDummies()
    Dim r As Range
    Dim i As Long

    ' The with-statement says that while we are inside the block, we are working on that object, saving us from having to type in that part of the address
    With ThisWorkbook.Sheets("Calendario")
        ' Set the range we are gonna loop over, the latter part of the range statements says that we go to the last cell in column D in which there is no data
        Set r = .Range(.Range("D8"), .Range("D" & .Rows.Count).End(xlUp))

        ' Loop over each cell in the range
        For i = 1 To r.Count
            ' Exit out of the sub if the cell is blank
            ' r.Cells(1, 1) = D8, r.Cells(2, 1) = D9, etc
            If IsEmpty(r.Cells(i, 1)) Then
                Exit Sub
            ' If not execute the code for that row
            ' D8 offset by 0,1 = E8, D8 offset by 0,3 = G8, etc
            ' A2 offset by 52,0 = A54
            Else
                .Range(r.Cells(i, 1).Offset(0, 1), r.Cells(i, 1).Offset(0, 3)).Copy _
                                    Destination:=Sheets("Export").Range("A2:C53").Offset(52 * (i - 1), 0)
            End If
        Next i
    End With
End Sub