VBA copy data from multiple worksheets and paste in a specific, preformatted sheet.

[Pettel]

Hi everyone,
I'm trying to gather information from multiple worksheets into a single preformatted table.
I've started with a dialog folder picker and I know the range that i need to copy from each sheet,but how do I paste what I've copied into a particular range and still have it offset.
For example I copy range "D4:R4" from "sheet1" and Paste it into "E5:S5" of "Sheet1_master", then I open another file and copy range "D4:R4" from "sheet1" but now i need to paste it to "E6:S6" of "Sheet1_master".

This is what I have so far:

Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
    xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
    xFileName = Dir(xFdItem & "*.xls*")
    Do While xFileName <> ""
    With Workbooks.Open(xFdItem & xFileName)
     Sheets("Scotopic A").Select
     Range("D4:R4").Copy Destination:=Sheets("Scotopic A_Master").Cells(Rows.Count, "E").End(xlUp).Offset(1, 0)
     End With
     xFileName = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

How do I proceed from here?

 

[Fluff]

Hi & welcome to MrExcel.
In what way doesn't your code work

 

[JLGWhiz]

It looks to me like you have the code for it so long as there are no blank cells it D4 of the copied range. If any of the D4 cells are blank then the E cell in the paste area will be blank and that will result in a false reading for the last row on the destination sheet. Other than that, copy the code to code module1 and run it.

Ooops! You need and End If In there.

If xFd.Show = -1 Then
    xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
    xFileName = Dir(xFdItem & "*.xls*")
End If

 

[Pettel]

Hi & welcome to MrExcel.
In what way doesn't your code work

It's not that it doesn't work ,i don't know how to write it so that it will paste the copied range to "E5:S5" and then paste the subseauent ranges into "E6:S6","E7:S7" etc....

 

[Fluff]

With the exception of the missing End If as posted by @JLGWhiz, your code should be doing what you want.

 

[Pettel]

It looks to me like you have the code for it so long as there are no blank cells it D4 of the copied range. If any of the D4 cells are blank then the E cell in the paste area will be blank and that will result in a false reading for the last row on the destination sheet. Other than that, copy the code to code module1 and run it.

Ooops! You need and End If In there.

If xFd.Show = -1 Then
    xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
    xFileName = Dir(xFdItem & "*.xls*")
End If

I added the "end if" but i get a "Subscript out of range " error for the line of the "Copy-Destination"

 

[Fluff]

That means you don't have a sheet called "Scotopic A_Master" in the active workbook. Is it it in the same workbook that contains the code?

 

[JLGWhiz]

It's not that it doesn't work ,i don't know how to write it so that it will paste the copied range to "E5:S5" and then paste the subseauent ranges into "E6:S6","E7:S7" etc....

This line of code does what you are concerned about.

Range("D4:R4").Copy Destination:=Sheets("Scotopic A_Master").Cells(Rows.Count, "E").End(xlUp).Offset(1, 0)

as far as incrementing the rows to paste in. The "Subscript out of range" error occurs when VBA cannot find an object that the code tells it to use. The cause can be spelling errors, missing or extra characters or non-existence of an object.

 

[Pettel]

That means you don't have a sheet called "Scotopic A_Master" in the active workbook. Is it it in the same workbook that contains the code?

I have defined the opened workbook as the opened one, how do I define a different active workbook for the pasting range?

 

[JLGWhiz]

try this modified code. It defines the two workbooks

Dim xFd As FileDialog, wb As Workbook
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
        If xFd.Show = -1 Then
            xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
            xFileName = Dir(xFdItem & "*.xls*")
        End If
        Do While xFileName <> ""
            Set wb = Workbooks.Open(xFdItem & xFileName)
                With wb.Sheets("Scotopic A")
                    .Range("D4:R4").Copy Destination:=ThisWorkbook.Sheets("Scotopic A_Master"). _
                    Cells(Rows.Count, "E").End(xlUp).Offset(1, 0)
                    wb.Close False
                End With
            xFileName = Dir
        Loop
    Application.ScreenUpdating = True
End Sub