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

Question

我目前正在使用一个工作簿并希望进行准备工作，copy/pasting我工作簿中的所有相关范围都包含在单独的工作sheet中（3 个工作sheet最多）。

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

目前，我的代码覆盖了从之前 sheet 复制的内容。

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

' 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

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

Copy varying range from multiple sheets and paste from same row

vba

range

paste

transpose

consolidation