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中的所有内容。如何修改代码以便我可以复制sheet1中的第一个范围，粘贴到表2范围B1：CW16，然后复制sheet1中的第二个范围，并粘贴到表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

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

1 个答案: