如何在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 

我已經在宏觀結束返回的計算模式，以自動。如果您希望保持手動，請刪除或註釋該行。