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

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 中创建循环以进行复制粘贴

How to create loop in excel for copy paste

excel

vba