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

Question

输入数据始终是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次fors和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

Answer 1

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

这是我最喜欢的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