VBA - Copy specific worksheet from multiple workbooks in one folder

[natheplas]

Hi All,

I have lots of workbooks in one folder. Each workbook contains a worksheet called 'Visit Report'.

My objective is to copy all visit report worksheets from every workbook within a folder to a master worksheet.

There is alot of this online, but I couldn't get any of the VBA to work for what I need.

The range of every worksheet is A1 - G38.

Ideally it would be amazing if it could copy all the worksheets data from those cells into a long horiontal list on the master please.

The folder is C:\temp1

Please let me know if anyone needs more info.

Thank you.

 

[Joe4]

The range of every worksheet is A1 - G38.

Ideally it would be amazing if it could copy all the worksheets data from those cells into a long horiontal list on the master please.

Do you really want this in a horizontal list?
So, your first sheet would paste to A1:G38, then your second would post to H1:N38, and your third to O1:U38, etc?

Hopefully you do not have more than 2340 workbooks, as there are only 16384 columns available in Excel, and at 7 columns per workbook, you could do 2340 before you bump into this limit.

 

[Joe4]

If I have interpretted your original question correctly, I think this will do what you want:

Sub MyCopy()

    Dim fDir As String
    Dim fl
    Dim mWb As Workbook
    Dim dWb As Workbook
    Dim mSh As Worksheet
    Dim nxtCol As Long

    Application.ScreenUpdating = False

'   Enter file directory where data files reside (make sure to put "\" at end)
    fDir = "C:\Temp\Joe\"

'   Capture name of current macro workbook to copy data to
    Set mWb = ActiveWorkbook
    
'   Set name of sheet data will be pasted to
    Set mSh = mWb.Sheets("Master")
    
'   Initialize column to paste to
    nxtCol = 1
    
'   Loop through all files in the the folder
    fl = Dir(fDir)
    Do While Len(fl) > 0
'       Open file
        Set dWb = Workbooks.Open(fl)
'       Copy data from
        dWb.Sheets("Visit Report").Range("A1:G38").Copy mSh.Cells(1, nxtCol)
'       Close workbook
        dWb.Close SaveChanges:=True
'       Increment column counter
        nxtCol = nxtCol + 7
'       Go to next file
        fl = Dir
    Loop
    
    Application.ScreenUpdating = True

'   Save master file
    mWb.Save
    
    MsgBox "Copy complete!"
    
End Sub

This saves the data to the file with this macro in it.
Be sure to update the sheet name to save the data to (I used "Master") and the file path in the code to match your scenario.

 

[natheplas]

Hi Joe4,

Thanks a lot for coming back to me. There is online like 300 workbooks.

I edited the code to match the folder with all my excel workbooks in.

Sub MyCopy()


Dim fDir As String
Dim fl
Dim mWb As Workbook
Dim dWb As Workbook
Dim mSh As Worksheet
Dim nxtCol As Long


Application.ScreenUpdating = False


' Enter file directory where data files reside (make sure to put "" at end)
fDir = "C:\temp1"


' Capture name of current macro workbook to copy data to
Set mWb = ActiveWorkbook

' Set name of sheet data will be pasted to
Set mSh = mWb.Sheets("Master")

' Initialize column to paste to
nxtCol = 1

' Loop through all files in the the folder
fl = Dir(fDir)
Do While Len(fl) > 0
' Open file
Set dWb = Workbooks.Open(fl)
' Copy data from
dWb.Sheets("Visit Report").Range("A1:G38").Copy mSh.Cells(1, nxtCol)
' Close workbook
dWb.Close SaveChanges:=True
' Increment column counter
nxtCol = nxtCol + 7
' Go to next file
fl = Dir
Loop

Application.ScreenUpdating = True


' Save master file
mWb.Save

MsgBox "Copy complete!"

End Sub



I get the following error:

'run time error 1004'

'sorry we couldnt find excel1.xlsx Is it possible it was moved, renamed or deleted?'

Do they all need to be open for this to work?

Is there a way for the VBA to open them and copy to master?

What you have suggested is ideal, if you could help me with the last bit. That would be amazing!

Cheers

 

[Joe4]

It "temp1" the name of the folder? If so, it should be:

[COLOR=#333333]fDir = "C:\temp1\"[/COLOR]

(note the comment I added to that part)

'   Enter file directory where data files reside ([COLOR=#ff0000]make sure to put "\" at end[/COLOR])

 

[natheplas]

Hi Joe4,

It was a typo when I pasted the code on here. I have fDir = "C:\temp1" on the VBA module, but still get that error.

It can't see the file and I don't know why? I've tried running it with it open too and I get the same error message.

 

[Fluff]

Try

Set dWb = Workbooks.Open(fDir & fl)

 

[natheplas]

Hi Fluff,

Thank you for looking at this one too. I amended the code, please see below:

It looked like it was going to worked, but I then got the following error:

Run-time error '9' Subscript out of range.

There is another backslash after 'temp1' but when I paste the code on here it deletes itself.

Any ideas?

Sub MyCopy()




Dim fDir As String
Dim fl
Dim mWb As Workbook
Dim dWb As Workbook
Dim mSh As Worksheet
Dim nxtCol As Long




Application.ScreenUpdating = False




' Enter file directory where data files reside (make sure to put "" at end)
fDir = "C:\temp1"




' Capture name of current macro workbook to copy data to
Set mWb = ActiveWorkbook


' Set name of sheet data will be pasted to
Set mSh = mWb.Sheets("Master")


' Initialize column to paste to
nxtCol = 1


' Loop through all files in the the folder
fl = Dir(fDir)
Do While Len(fl) > 0
' Open file
Set dWb = Workbooks.Open(fDir & fl)
' Copy data from
dWb.Sheets("Visit Report").Range("A1:G38").Copy mSh.Cells(1, nxtCol)
' Close workbook
dWb.Close SaveChanges:=True
' Increment column counter
nxtCol = nxtCol + 7
' Go to next file
fl = Dir
Loop


Application.ScreenUpdating = True




' Save master file
mWb.Save


MsgBox "Copy complete!"


End Sub

 

[Fluff]

That suggest that you don't have a sheet called "Visit report" in the file that had just been opened.

Also when posting code, please use code tags, the # icon in the reply window.