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

Pettel

New Member
Joined
Jan 23, 2020
Messages
14
Office Version
365
Platform
Windows
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:
Code:
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
33,573
Office Version
365
Platform
Windows
Hi & welcome to MrExcel.
In what way doesn't your code work
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
11,411
Office Version
2013
Platform
Windows
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.
Code:
If xFd.Show = -1 Then
    xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
    xFileName = Dir(xFdItem & "*.xls*")
End If
 
Last edited:

Pettel

New Member
Joined
Jan 23, 2020
Messages
14
Office Version
365
Platform
Windows
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
33,573
Office Version
365
Platform
Windows
With the exception of the missing End If as posted by @JLGWhiz, your code should be doing what you want.
 

Pettel

New Member
Joined
Jan 23, 2020
Messages
14
Office Version
365
Platform
Windows
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.
Code:
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
33,573
Office Version
365
Platform
Windows
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

Well-known Member
Joined
Feb 7, 2012
Messages
11,411
Office Version
2013
Platform
Windows
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.
Code:
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

New Member
Joined
Jan 23, 2020
Messages
14
Office Version
365
Platform
Windows
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

Well-known Member
Joined
Feb 7, 2012
Messages
11,411
Office Version
2013
Platform
Windows
try this modified code. It defines the two workbooks
Code:
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
 

Forum statistics

Threads
1,085,151
Messages
5,382,002
Members
401,765
Latest member
Parrotdise

Some videos you may like

This Week's Hot Topics

Top