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?

 

[Pettel]

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

No,there is still an "out of range" error

 

[Pettel]

No,there is still an "out of range" error

If it helps I named the master workbook "Master_ERG"

 

[Fluff]

With your code try

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

Change extension to suit.

 

[Pettel]

With your code try

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

Change extension to suit.

Nope...still out of range.

 

[Fluff]

Is the Scotopic A_Master sheet in the Master_ERG workbook?
If so check the spelling of both the sheet & workbook as one of them is wrong

 

[Pettel]

So I copied the name of the sheet and pasted it into the code. and it ran. but the result was weird.
This is what a "Scotopic A" sheet looks like

This is what the master sheet looks like I ran the code on three test files

I suspect that this has something to do with the fact that test files have a "Sheet1" that looks like this

 

[Fluff]

What code are you currently using?

 

[Pettel]

What code are you currently using?

Sub Macro2()
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("C4:R4").Copy Destination:=Workbooks("Master_ERG.xlsm").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

 

[Pettel]

Sub Macro2()
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("C4:R4").Copy Destination:=Workbooks("Master_ERG.xlsm").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

The problem seems to be that it's taking the range from "Sheet 1" of each open file rather then from "Scotopic A"

 

[Fluff]

You need a full stop at the start of this line

.Range("C4:R4").Copy