从多张纸复制不同的范围并从同一行粘贴

Question

我目前正在使用一个工作簿，并希望实施一项准备工作，从包含在单独工作表中的工作簿中复制/粘贴所有相关范围（最多 3 个工作表）。

我有下面的代码来循环工作表，不幸的是我无法编写粘贴命令以便从同一行连续粘贴这些范围。我想要转置：= True。 I.E Rgn from sheet1 从 B2 开始，在右侧最后一个填充的单元格从 Sheet2 开始 Rgn 之后，在最后一个填充的单元格从 Sheet3 开始 Rgn 之后（前提是 Sheet3 存在 Rgn）。

目前，我的代码会覆盖从上一张表中复制的内容。

我在这里找到了一个潜在的参考 (VBA Copy Paste Values From Separate Ranges And Paste On Same Sheet, Same Row Offset Columns (Repeat For Multiple Sheets))，但我不确定如何使用地址，也不确定如何在解决方案中设置偏移量。

' Insert temporary tab
Set sh = wb.Sheets.Add(after:=wb.Sheets(wb.Sheets.Count))
sh.Name = "Prep"


'Loop
For Each sh In wb.Worksheets
    Select Case sh.Index
        Case 1
           Sheets(1).Range("D16:D18").Copy

        Case 2
           lastrow = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row
           lastcol = Sheets(2).Cells(9, Columns.Count).End(xlToLeft).Column
           Set Rng = Sheets(2).Range("M9", Sheets(2).Cells(lastrow, lastcol))
           Rng.Copy

        Case 3
             'Check if Range (first col for answers) is not empty   
             If Worksheetunction.CountA(Range("L9:L24")) = 0 Then
                   Exit For
             Else
                   lastrow = Sheets(3).Range("A" & Rows.Count).End(xlUp).Row
                   lastcol = Sheets(3).Cells(9, Columns.Count).End(xlToLeft).Column
                   Set Rng = Sheets(3).Range("L9", Sheets(3).Cells(lastrow, lastcol))
                   Rng.Copy


              End If

     End Select

     wb.Sheets("Prep").UsedRange.Offset(1,1).PasteSpecial Paste:=xlPasteAll, Transpose:=True

 Next
 Set sh = Nothing
 Set Rng = Nothing

Answer 1

你可以试试这个吗？ UsedRange 可能无法预测。如果Rng 的第一个单元格中没有任何内容，您也可能会遇到问题，在这种情况下，需要调整此代码。

我也更喜欢使用工作表名称而不是索引。

Sub x()

Dim sh As Worksheet, wb As Workbook, Rng As Range

Set sh = wb.Sheets.Add(after:=wb.Sheets(wb.Sheets.Count))
sh.Name = "Prep"

'Loop
For Each sh In wb.Worksheets
    Select Case sh.Index
        Case 1
            Set Rng = sh.Range("D16:D18")
        Case 2
            lastrow = sh.Range("A" & Rows.Count).End(xlUp).Row
            lastcol = sh.Cells(9, Columns.Count).End(xlToLeft).Column
            Set Rng = sh.Range("M9", sh.Cells(lastrow, lastcol))
        Case 3
            'Check if Range (first col for answers) is not empty
            If WorksheetFunction.CountA(sh.Range("L9:L24")) = 0 Then
                Exit For
            Else
                lastrow = sh.Range("A" & Rows.Count).End(xlUp).Row
                lastcol = sh.Cells(9, Columns.Count).End(xlToLeft).Column
                Set Rng = sh.Range("L9", sh.Cells(lastrow, lastcol))
            End If
    End Select
    Rng.Copy
    wb.Sheets("Prep").Cells(2, Columns.Count).End(xlToLeft).Offset(, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
Next

Set sh = Nothing
Set Rng = Nothing

End Sub