VBA Excel 从工作簿复制粘贴到另一个工作簿转置值和不同的范围

VBA Excel copy-paste from workbook to another workbook transpose values and different ranges

输入数据始终是7个不同工作表中的列,需要跨不同的非顺序行输出到不同的列中

Q2_1    Q3_1    Q4_1
13      17      11
4        2       5
3        2       4
2        2       4
6        5       4

行(输出)的顺序是 5, 10, 15, 23, 28, 33, 38, 43, 48, 53, 61, 66, 71, 79, 84, 89, 94, 102, 107、112、117、122、128、135、140、148、153、158、166、171、179、184、189、194

Q2_1 的列从 i5 到 M5,Q3 的列从 i10 到 M10

我已经尝试了 2 个 for 和 2 个 do 循环,但没有成功。有什么方法可以使用数组吗?

我很喜欢编程。

Sub CPRelative()

    Dim n As Integer
    Dim i As Integer
    Dim itotal As Integer

    Windows("book1.xlsx").Activate
    Sheets(3).Select

    For n = 2 To 35
        ActiveSheet.Range(Cells(4, n), Cells(8, n)).Select
        Selection.Copy

        Windows("book2.xlsm").Activate


         For i = 5 To 194

            Select Case i
            Case 5, 10, 15, 23, 28, 33, 38, 43, 48, 53, 61, 66, 71, 79, 84, 89, 94, 102, 107, 112, 117, 122, 128, 135, 140, 148, 153, 158, 166, 171, 179, 184, 189, 194

                ActiveSheet.Range(Cells(i, 9), Cells(i, 13)).Select
               Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            End Select
        Next n
End Sub

并执行直到和执行时

Sub NestedLoop()
    Dim n As Integer
    Dim i As Integer

    Windows("book1.xlsx").Activate
    Sheets(3).Select

    n = 2
    Do Until ActiveSheet.Range(Cells(4, n), Cells(8, n)).Value = ("8,n")

        ActiveSheet.Range(Cells(4, n), Cells(8, n)).Select
        Selection.Copy

        Windows("book2.xlsm").Activate
        Sheets(1).Select

        'i = 5

        Do While ActiveSheet.Range(Cells(i, 9), Cells(i, 13)).Value = ""
            Select Case i
            Case 5, 10, 15, 23, 28, 33, 38, 43, 48, 53, 61, 66, 71, 79, 84, 89, 94, 102, 107, 112, 117, 122, 128, 135, 140, 148, 153, 158, 166, 171, 179, 184, 189, 194
               ActiveSheet.Range(Cells(i, 9), Cells(i, 13)).Select
               Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
           End Select

           i = i + 1
       Loop
       n = n + 1
    Loop
End Sub

在屏幕截图之前和之后添加将导致更快的响应和更好的答案。

这是我最喜欢的 VBA Excel 视频系列中的一个视频,您必须观看:Excel VBA Introduction Part 5 - Selecting Cells (Range, Cells, Activecell, End, Offset)

来源

目标

Sub CPRelative2()
    Dim n As Long, r As Long
    Dim arrRows As Variant
    Dim Source As Range, Target As Range
    Set Source = Workbooks("180610_SequencingScenarioTEST1.xlsx").Worksheets("Sheet1").Cells
    Set Target = Workbooks("180610_TestSurveyAnalysisTest1.xlsm").Worksheets("Sheet1").Cells

    arrRows = Array(5, 10, 15, 23, 28, 33, 38, 43, 48, 53, 61, 66, 71, 79, 84, 89, 94, 102, 107, 112, 117, 122, 128, 135, 140, 148, 153, 158, 166, 171, 179, 184, 189, 194)
    For n = 2 To 35
         r = arrRows(n - 2)
        Target.Cells(r, "I").Resize(1, 5).Value = WorksheetFunction.Transpose(Source.Cells(4, n).Resize(5, 1).Value)
    Next

End Sub