将 3 个单元格从列复制到行的 VBA 代码

Question

这是我第一天的 VBA 编码，我试图将多组 3 个单元格复制到工作表上的另一个位置并转置它们。请查看以下代码以供引用:

Range("A4:A6").Select
Selection.Copy
Range("D1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
Range("A8:A10").Select
Selection.Copy
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
Range("A12:A14").Select
Selection.Copy
Range("D3").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
Range("A16:A18").Select
Selection.Copy
Range("D4").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
Range("A20:A22").Select
Selection.Copy
Range("D5").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True

所以我想为接下来的 200 个单元格运行此代码。有什么建议吗？

Answer 1

您不需要选择，甚至不需要复制/粘贴。这会更快:

Dim l As Long
For l = 1 To 200
    With Sheet1
        .Cells(l, "D").Resize(1, 3) = Application.Transpose(.Cells(l * 4, "A").Resize(3, 1))
    End With
Next l