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

我不确定循环的逻辑是如何工作的。 我在第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行步骤）？

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

您可以对其进行修改，以转置源工作表中不同范围内不同数量的列和行

从何处复制：

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

---

我不能理解你的逻辑。。。但是，您是否尝试过查看

转置

函数？因此您复制的原始数据子集越来越小？直到你只剩下一列？是的。每次只复制一列到右边。对不起，我的意思是我想做一个循环，从单元格J6开始，复制100行和16列的范围。并在第2页（B1:CW16）处转置和粘贴。然后从单元格K6开始，复制另一个100行16列的范围，并在第2页（B19:CW34）处转置和粘贴。然后从单元格L6开始（另外100行16列）。。。。。。。我在网上搜索到了以下代码：这和你原来的问题不一样。请编辑您的问题以准确描述您的问题。