将列范围复制到VBA中的单个系列中

Question

我的数据范围跨越几列(C:D) ， (M:N)和(Q:R) 。 我试图复制每个系列中的第一行并将其粘贴到另一个工作表。 如将范围组合成单个范围，具有以下顺序

我试图做的复制和粘贴的顺序是

1. 第一排范围(C:D)
2. 第一排范围(M:N)
3. 第一排范围(Q:R)
4. 第二排范围(C:D)
5. 第二行范围(M:N)
6. 第二排范围(Q:R)

然后是第三行等等。我正在尝试将范围粘贴到另一张表中。

到目前为止，我通过一次复制每一行并一个接一个地粘贴来完成此操作。 但我发现很难将其转换为循环，将任意数量的行复制并粘贴到另一个工作表。

Sub CopyCol()

Sheets("Sheet10").Range("C2:D2").Copy
Sheets("Sheet11").Range("B2:C2").PasteSpecial xlPasteValues

Sheets("Sheet10").Range("M2:N2").Copy
Sheets("Sheet11").Range("B3:C3").PasteSpecial xlPasteValues

Sheets("Sheet10").Range("Q2:R2").Copy
Sheets("Sheet11").Range("B4:C4").PasteSpecial xlPasteValues

Sheets("Sheet10").Range("C3:D3").Copy
Sheets("Sheet11").Range("B5:C5").PasteSpecial xlPasteValues

Sheets("Sheet10").Range("M3:N3").Copy
Sheets("Sheet11").Range("B6:C6").PasteSpecial xlPasteValues

Sheets("Sheet10").Range("Q3:R3").Copy
Sheets("Sheet11").Range("B7:C7").PasteSpecial xlPasteValues

...
End Sub

复制和粘贴不会停在那里继续。 我刚刚粘贴了一段代码。 每个系列中的行数为45。

有没有办法减少行数？ 我无法弄清楚如何使用循环来做到这一点。

任何帮助或任何建议将非常有用，真的很感激。

提前致谢。

Answer 1

请参阅以下代码 - 以下是需要注意的要点：

• 你可以创建工作表和范围引用（ wsSource ， rngSource等），这可以防止你需要经常引用Sheets("Sheet10")或Range("C2:D2")等 - 这也是一个很好的做法。

• 您可以使用其他变量来定义范围变量 - 下面的代码有两个计数器 - 一个用于45行源数据，另一个用于跟踪另一个工作表中的目标行

• 你需要循环遍历源数据，但是当你追加到相同的列B:C你不会遍历目标数据，因此只需要一个行计数器来跟踪你在目标表中的位置

HTH

Sub CopyCol()

    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet

    Dim rngSource As Range
    Dim rngTarget As Range

    Dim intSourceRowCounter As Integer
    Dim intTargetRowCounter As Integer

    Set wsSource = ThisWorkbook.Worksheets("Sheet10")
    Set wsTarget = ThisWorkbook.Worksheets("Sheet11")

    intTargetRowCounter = 1
    For intSourceRowCounter = 1 To 45
        Set rngSource = wsSource.Range("C" & intSourceRowCounter & ":" & "D" & intSourceRowCounter)
        Set rngTarget = wsTarget.Range("B" & intTargetRowCounter & ":" & "C" & intTargetRowCounter)
        rngTarget.Value = rngSource.Value
        intTargetRowCounter = intTargetRowCounter + 1

        Set rngSource = wsSource.Range("M" & intSourceRowCounter & ":" & "N" & intSourceRowCounter)
        Set rngTarget = wsTarget.Range("B" & intTargetRowCounter & ":" & "C" & intTargetRowCounter)
        rngTarget.Value = rngSource.Value
        intTargetRowCounter = intTargetRowCounter + 1

        Set rngSource = wsSource.Range("Q" & intSourceRowCounter & ":" & "R" & intSourceRowCounter)
        Set rngTarget = wsTarget.Range("B" & intTargetRowCounter & ":" & "C" & intTargetRowCounter)
        rngTarget.Value = rngSource.Value
        intTargetRowCounter = intTargetRowCounter + 1

    Next intSourceRowCounter

End Sub