Excel VBA复制和转置范围循环

Question

我正在尝试将范围内的值从一张图纸复制并转置到另一张图纸。

 01 02  03  04  05  06  07  08  09  10  11

 A  B   C   D   E   F    G  H    I   J  K

 12 13  14  15  16  17  18  19  20  21 22

 L   M   N   O  P   Q   R   S   T    U  V

收件人：

1   A   12  L
2   B   13  M
3   C   14  N
4   D   15  O
5   E   16  P
6   F   17  Q
7   G   18  R
8   H   19  S
9   I   20  T
10  J   21  U
11  K   22  V

所以我想从4x11的表转到11x4的表，我有2212行数据，这使我可以转置553个表。

我已经有以下代码：

Sub Transpose_Copy_Loop()

    Dim CopyRange As Range, OutputCell As Range
    Dim r As Long, n As Long, nRows As Integer


    n = 5
    nRows = 12



    For r = 0 To n - 1

       Set CopyRange = Worksheets("Sheet6").Range("B1:L4").Offset(r * nRows, 0)
        CopyRange.Copy

        Set OutputCell = Worksheets("Sheet7").Range("A1").Offset(r * nRows, 0)
        OutputCell.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

    Next

    Application.CutCopyMode = False

End Sub

该代码有效，但它仅占用每个第4个表并将其转置到另一个工作表。所以表1、4、7、10、13、16等。我似乎找不到原因。任何帮助将不胜感激！

Answer 1

从此：

这是转置值：

代码非常灵活：

Sub TestMe()

    Dim wks1 As Worksheet: Set wks1 = Worksheets(1)
    Dim wks2 As Worksheet: Set wks2 = Worksheets(2)

    Dim myVar As Variant
    With Application
        myVar = .Transpose(wks1.Range("A1:D5"))
    End With

    Dim loopRows As Long
    Dim loopCols As Long

    For loopRows = LBound(myVar, 1) To UBound(myVar, 1)
        For loopCols = LBound(myVar, 2) To UBound(myVar, 2)
            wks2.Cells(loopRows, loopCols) = myVar(loopRows, loopCols)
        Next
    Next

End Sub

• 代码的想法是将范围内的值写入多维数组-
  myVar = Application.Transpose(wks1.Range("A1:D5"))
• 完成此操作后，循环遍历数组并将值写入相应的行和列即可得到所需的内容。