vba - 在 VBA 中将列范围复制到单个系列中

Question

我有跨越几列的数据范围(C:D) , (M:N)和 (Q:R) .我正在尝试复制每个系列中的第一行并将其粘贴到另一张纸上。如将范围组合成具有以下序列的单个范围

我想要做的复制和粘贴的顺序是

范围的第一行 (C:D)

范围的第一行 (M:N)

范围的第一行 (Q:R)

第二行范围(C:D)

第二行范围(M:N)

第二行范围(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因此只需要一个行计数器来跟踪您在目标表中的位置

高温高压

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