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时，不要遍历目标数据，因此只需要一个行计数器来跟踪您的位置在目标表中

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

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

1 个答案: