Excel 循环复制工作表 1 中的范围并粘贴到工作表 2

Question

我不确定循环的逻辑是如何工作的。 我在第 1 页有一个表格，有 105 行和 120 列。 我想做一个循环，从单元格 J6 开始，复制 100 行和 16 列的范围。 并在工作表 2 (B1:CW16) 上转置和粘贴。 然后从单元格 K6 开始，复制另一个 100 行和 16 列的范围，然后转置并粘贴到工作表 2（B19：CW34）。 然后从单元格 L6 开始（另外 100 行和 16 列）并粘贴到工作表 2。（在工作表 2 中每 18 行粘贴一次）

我在网上搜索并有以下代码：

Sub transpose()
Dim ColNum As Long
Dim i as long
For ColNum = 10 To 108
    LR = Range("B" & Rows.Count).End(xlUp).Row
       Sheet1.Activate
       Range((Cells(6, ColNum)), (Cells(105, ColNum + 15))).copy

       'Transpose
       Sheet2.Activate
        For i = 1 To LR Step 18

       Cells(i, 2).Select
       Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, 
SkipBlanks:=False, transpose:=True
   Next i
  Next ColNum
End Sub

这段代码没有给我我想要的。 此代码复制工作表 1 中的一个范围并在工作表 2 中多次粘贴，然后复制工作表 1 中的第二个范围并替换工作表 2 中的所有内容。如何修改代码以便我可以复制工作表 1 中的第一个范围，粘贴到工作表 2 范围 B1:CW16，然后复制工作表 1 中的第二个范围，并粘贴到工作表 2 范围 B19:CW34。 （第 2 页上 18 行的步骤）？

Answer 1

不是最优雅的，但这应该会有所帮助。 我试图使这些术语尽可能具有描述性，以帮助您了解每个阶段的情况。

您可以修改这些以从源工作表中的不同范围转置不同数量的列和行。

从哪里复制： startCell

何时结束复制： endCell

从哪里开始粘贴到： targetStartCell

转置多少： copyRowSize ， copyColumnSize

控制转置的下一行目标的步骤： rowStep

Option Explicit

Public Sub TransposeToOtherSheet()

    Dim wb As Workbook
    Set wb = ThisWorkbook
    Dim ws As Worksheet
    Set ws = wb.Worksheets("Sheet1")             'change as appropriate

    Const numberOfRows As Long = 105
    Const numberOfColumns As Long = 120
    Const copyRowSize As Long = 100
    Const copyColumnSize As Long = 16
    Const rowStep As Long = 18

    Dim startCell As Range
    Dim endCell As Range

    Set startCell = ws.Range("J6")
    Set endCell = ws.Range("DY6")

    Dim targetSheet As Worksheet
    Dim targetStartCell As Range
    Dim targetRow As Long
    Dim targetColumn As Long

    Set targetSheet = wb.Worksheets("Sheet2")   'change as appropriate
    Set targetStartCell = targetSheet.Range("A1")
    targetRow = targetStartCell.Row
    targetColumn = targetStartCell.Column

    Dim currentColumn As Long
    Dim headerRow As Long
    headerRow = startCell.Row
    Dim targetRowCounter As Long

    For currentColumn = startCell.Column To endCell.Column

        If targetRowCounter = 0 Then

           targetStartCell.Resize(copyColumnSize, copyRowSize) = Application.WorksheetFunction.Transpose(ws.Cells(headerRow, currentColumn).Resize(copyRowSize, copyColumnSize))

        Else

         ' Debug.Print "destination range " & targetSheet.Cells((targetRowCounter * rowStep) + targetRow, targetColumn).Resize(copyColumnSize, copyRowSize).Address
          targetSheet.Cells((targetRowCounter * rowStep) + targetRow, targetColumn).Resize(copyColumnSize, copyRowSize) = Application.WorksheetFunction.Transpose(ws.Cells(headerRow, currentColumn).Resize(copyRowSize, copyColumnSize))

        End If

        targetRowCounter = targetRowCounter + 1

    Next currentColumn

End Sub