Copy varying range from multiple sheets and paste from same row

Question

I am working currently with one workbook and want to implement a preparatory work, copy/pasting all the relevant range from my workbook contained in separate worksheets (3 worksheets at most).

I have the below code to loop through the worksheets, unfortunately I am unable to write the paste-command so as to paste these ranges from the same row successively. I want Transpose:= True. I.E Rgn from sheet1 starting from B2, after last filled cell on the right starts Rgn from Sheet2, after last filled cell starts Rgn from Sheet3 (provided Rgn exists for Sheet3).

Currently, my code overwrites what was copied from previous sheet.

I found a potential reference here (VBA Copy Paste Values From Separate Ranges And Paste On Same Sheet, Same Row Offset Columns (Repeat For Multiple Sheets)) but I am not sure how to use Address nor how the Offset is set in the solution.

' 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

Can you try this? UsedRange can be unpredictable. You can also have problems if you don't have anything in the first cell of Rng, in which case this code will need adjusting.

I would also prefer to use the sheeet name rather than index.

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