创建复制/粘贴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