将一列的奇数行复制到另一列的偶数行

Question

我有一张包含大约 860 条记录的工作表。大小可以变化，但不会超过一千行。

我想将代码应用于整个工作表。

我想从 A 列复制奇数行的值并将该值粘贴到 B 列的偶数行中。

我想从 C 列复制奇数行的值并将该值粘贴到 D 列的偶数行中。

我想从 E 列复制奇数行的值并将该值粘贴到 F 列的偶数行中。

我不知道如何转到下一个奇数行（A5 到 B4，C5 到 D4，E5 到 F4），直到值出现空白，这将是我的工作表的结尾。

Sub myAwesomeMacro()

    For i = 1 To 1000
        Range("A3").Copy Range("B2")
        Range("A3").Copy Range("D2")
        Range("E3").Copy Range("F2")
    Next i
End Sub

我想在这个循环中实现的目标：
复制 A3 并将该值粘贴到 B2
复制 C3 并将该值粘贴到 D2
复制 E3 并将该值粘贴到 F2

然后取下一个奇数行并通过相同的模式：
复制 A5 并将该值粘贴到 B4
复制 C5 并将该值粘贴到 D4
复制 E5 并将该值粘贴到 F4

然后取下一个奇数行并通过相同的模式：
复制 A7 并将该值粘贴到 B6
复制 C7 并将该值粘贴到 D6
复制 E7 并将该值粘贴到 F6

Answer 1

它会完成你的工作

Dim i As Long
Dim lastrow As Variant

With ActiveSheet
   lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
   For i = 3 To lastrow
      .Cells(i-1, "B") = .Cells(i, "A")
      .Cells(i-1, "D") = .Cells(i, "C")
      .Cells(i-1, "F") = .Cells(i, "E")
   Next i
End With

Answer 2

你可以这样做：

Sub myAwesomeMacro()
Dim i As Long

i = 3
Do While Len(Cells(i, 1).Value) > 0
    Cells(i, 1).Copy Cells(i-1, 2)
    Cells(i, 3).Copy Cells(i-1, 4)
    Cells(i, 5).Copy Cells(i-1, 6) 
    i = i + 1
Loop

End Sub