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

Pettel

New Member
Joined
Jan 23, 2020
Messages
18
Office Version
  1. 365
Platform
  1. 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?
 

Some videos you may like

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type

Fluff

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

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. 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
18
Office Version
  1. 365
Platform
  1. 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
52,755
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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
18
Office Version
  1. 365
Platform
  1. 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
52,755
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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
12,979
Office Version
  1. 2013
Platform
  1. 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
18
Office Version
  1. 365
Platform
  1. 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
12,979
Office Version
  1. 2013
Platform
  1. 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
 

Watch MrExcel Video

Forum statistics

Threads
1,122,232
Messages
5,594,956
Members
413,954
Latest member
mrsandy

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top