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?
 

Pettel

New Member
Joined
Jan 23, 2020
Messages
18
Office Version
  1. 365
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
No,there is still an "out of range" error
 

Some videos you may like

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
50,527
Office Version
  1. 365
Platform
  1. Windows
With your code try
Rich (BB code):
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

New Member
Joined
Jan 23, 2020
Messages
18
Office Version
  1. 365
Platform
  1. Windows
With your code try
Rich (BB code):
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
50,527
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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

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

This is what the master sheet looks like I ran the code on three test files
Scotopic ERG Master.png

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

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
50,527
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

What code are you currently using?
 

Pettel

New Member
Joined
Jan 23, 2020
Messages
18
Office Version
  1. 365
Platform
  1. Windows
What code are you currently using?
VBA Code:
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

New Member
Joined
Jan 23, 2020
Messages
18
Office Version
  1. 365
Platform
  1. Windows
VBA Code:
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"
Sheet1.png
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
50,527
Office Version
  1. 365
Platform
  1. Windows
You need a full stop at the start of this line
Rich (BB code):
.Range("C4:R4").Copy
 

Watch MrExcel Video

Forum statistics

Threads
1,118,074
Messages
5,570,048
Members
412,308
Latest member
cornelb
Top