循环遍历行以复制和粘贴特殊答案

【问题标题】：Loop through rows to copy and paste special循环遍历行以复制和粘贴特殊
【发布时间】：2012-05-02 07:49:22
【问题描述】：

电子表格有这样的数据：

A B C D E 2 20120425 09:55:00 101 99 102 100.50 3 20120425 09:55:00 101 102 98 101.50

我想在同一张纸上这样做：

H 2 101 3 99 4 102 5 100.50

复制范围 B2:E2 然后选择 H2 并特殊粘贴（它将粘贴在 H2、H3、H4、H5 上）。然后重复 B3 的任务：E3 复制范围并将特殊粘贴到 H6。

我记录了宏，但任务必须在近 5000 行上重复。

记录代码

Sub Macro9()
'
' Macro9 Macro
'

'
    Range("D1:G1").Select
    Selection.Copy
    Range("L1:L4").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("D2:G2").Select
    Selection.Copy
    Range("L5:L8").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
End Sub

【问题讨论】：

请标注编程语言、环境等相关信息

标签： excel vba for-loop

【解决方案1】：

不知何故想出了答案。

Sub alex4()

Dim k As Integer, i As Integer, lngRows As Integer    

lngRows = Range("A1").CurrentRegion.Rows.Count    

For k = 1 To (lngRows * 4)         

    For i = 1 To lngRows    

        k = k + 4   

        Range(Cells(i, 4), Cells(i, 7)).Select    

        Selection.Copy    

        Range(Cells(k, 12), Cells(k + 3, 12)).Select    

        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
          False, Transpose:=True    

    Next i    

Next k      

End Sub

【讨论】：