0

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
Jules
  • 15
  • 4
  • You want to paste the rows as columns to the right of each other each time? – SJR Aug 28 '19 at 12:44
  • yes that's excatly what I am looking for. – Jules Aug 28 '19 at 12:47
  • Is the initial destination a particular row or column? You are offsetting from usedrange which could be a variable cell. – SJR Aug 28 '19 at 12:49
  • initial destination could be A1, but to avoid additional coding, i would prefer to start from B2. That's why I inserted Offset... – Jules Aug 28 '19 at 12:52

1 Answers1

0

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
SJR
  • 22,986
  • 6
  • 18
  • 26
  • Additional question if I may, why use End(xlToLeft) when range are pasted successively to the right ? – Jules Aug 28 '19 at 13:06
  • `Cells(2, Columns.Count)` means we go to the very last column in row 2 and then `xltoleft` takes us back to the left and stops at the first filled cell, then we offset 1 to the right. You can see this on a sheet by using ctrl+End and ctrl + left arrow. – SJR Aug 28 '19 at 13:08
  • 1
    Right, I see. You've made my day ;-) – Jules Aug 28 '19 at 13:11