创建复制/粘贴 VBA 循环

Question

我在一个大型电子表格中有一个庞大的数据集（1000 个值），我需要将这些值复制并粘贴到一个新工作表中，每组 10 个。基本上我需要复制一列中的前 10 个单元格，然后将它们粘贴到新工作表中自己的列中。然后我需要对单元格 11-20 重复此操作，并将它们粘贴到新工作表中自己的列中。因此：复制 1-10，粘贴到 A 列的新工作表中。然后复制 11-20 并粘贴到相同的新工作表 B 列中。C 列中的 21-30，依此类推。

我已经尝试了一些基本的代码，我真的很陌生，但觉得它很有趣。我已经想出了如何复制 10 的范围并粘贴到新工作表，但我不知道如何设置循环，因此我可以将这个过程继续到新列中，增加 10 组。我也尝试过记录宏，但是它只是从字面上重新创建我输入的击键，这对我没有用。

我写这篇文章是为了复制源列中的前 10 个，然后粘贴到他们新列中的新工作表中。

Option Explicit
Sub CopyCells()
Worksheets("Sheet1").Range("A3:A12").Copy Worksheets("Sheet2").Range("B2:B11")
End Sub

我需要它循环并不断地将一组 10 个单元格从一个目标列剪切并粘贴到一个新工作表中，并将每组 10 个单元格粘贴到它们自己的新列中。如果您发布答案，您是否也可以添加解释？我真的很喜欢这些东西并且正在努力学习，而不仅仅是复制粘贴一些代码。谢谢！

Answer 1

你可以这样做：

Sub CopyCells()
    Const NUM_ROWS As Long = 10  'size of block to copy
    Dim rngCopy As range, col As Long

    Set rngCopy = Worksheets("Sheet1").Range("A3").Resize(NUM_ROWS, 1)
    col = 2
    'copy while rngCopy has any data
    Do While Application.Counta(rngCopy) > 0
        rngCopy.Copy Worksheets("Sheet2").Cells(2, col)
        col = col + 1                       'increment destination column
        Set rngCopy = rngCopy.Offset(NUM_ROWS, 0) 'move copy range down 10
    Loop

End Sub