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

【问题标题】：Excel loop copy a range in sheet 1 and paste to sheet 2Excel循环复制工作表1中的范围并粘贴到工作表2
【发布时间】：2018-08-08 18:17:16
【问题描述】：

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

【问题讨论】：

我无法遵循您的逻辑...但是您是否尝试过查看 TRANSPOSE 函数？
所以您正在复制越来越小的原始数据子集？直到你只剩下一列？
是的。每次只需向右复制一列。
对不起，我的意思是我想做一个循环，从单元格 J6 开始，复制 100 行和 16 列的范围。并在表 2 (B1:CW16) 上转置和粘贴。然后从单元格 K6 开始，复制另一个 100 行和 16 列的范围，然后转置并粘贴到工作表 2(B19:CW34)。然后从单元格 L6 开始（另外 100 行 16 列）.......我在网上搜索了以下代码：
这与您的原始问题不同。请编辑您的问题以准确描述您的问题。

标签： vba excel loops for-loop

【解决方案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

【讨论】：