Question

我试图复制和过去转置，并且有很多行。以下代码来自记录宏，如何在sheet2中创建循环到L1000：N1000？

 Sub Macro4()
    Sheets("sheet2").Select
    Range("L5:N5").Select
    Selection.Copy
    Sheets("Sheet1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

    Sheets("sheet2").Select
    Range("L6:N6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet1").Select
    Range("B14").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

    Sheets("sheet2").Select
    Range("L7:N7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet1").Select
    ActiveWindow.SmallScroll Down:=6
    Range("B24").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
End Sub

Answer 1

由于您要复制为Paste Special Paste:=xlPasteAll, Transpose:=True，因此我保留了您的公式和格式。如果只希望在转置数组中引入值，则还有其他方法会更快。

这从目的地B4开始，每个连续循环增加10行;例如B4，B14，B24等

Sub Copy_From_WS1_to_WS2_by_10()
    Dim rw As Long
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    With Sheets("Sheet1")
        For rw = 4 To 1000
            .Cells(rw, 12).Resize(1, 3).Copy
            Sheets("Sheet2").Cells(4 + (rw - 4) * 10, 2).PasteSpecial _
              Paste:=xlPasteAll, Transpose:=True, Operation:=xlNone, SkipBlanks:=False
            Application.CutCopyMode = False
        Next rw
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

我已将计算模式返回到宏末尾的自动。如果您希望保留手册，请删除或注释该行。

如何在Excel中创建循环以进行复制粘贴

1 个答案: