Merging multiple files in to one using a macro - Urgent :(

lyyynnnchy

New Member
Joined
Sep 10, 2014
Messages
5
Hi All, First time poster :) This forum is a lifesaver!

I'm trying to merge multiple excel files in the same folder in to 1 blank workbook. All files in the directory need to be merged and all worksheets in each file need to be transferred across.

At the moment I'm trying to use

Code:
Sub MergeSheets()    Dim SrcBook As Workbook
    Dim fso As Object, f As Object, ff As Object, f1 As Object
       
    Application.ScreenUpdating = False
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.Getfolder("[I][B]My Path[/B][/I]")
    Set ff = f.Files
    
    For Each f1 In ff
        Set SrcBook = Workbooks.Open(f1)
        Sheets("Data").Select
        Range("A1:IV" & Range("A65536").End(xlUp).Row).Copy
        ThisWorkbook.Worksheets(1).Activate
        Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
        Application.CutCopyMode = False
        SrcBook.Close
    Next
End Sub

But it comes up with the error

Run-time error '9':
Subscript out of range
 
Last edited:

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Maybe this... UNTESTED
Paste the code into your new , open, blank, workbook !
Code:
Public Sub MM1()
Dim wbk As Workbook, Filename As String, Path As String
Dim ws As Worksheet, lr As Long, wb As Workbook, lr2 As Long
Application.ScreenUpdating = False
Set wb = ActiveWorkbook
Path = "D:\Temp\TESTING\" ' CHANGE TO SUIT
Filename = Dir(Path & "*.xls")
'--------------------------------------------
'OPEN EXCEL FILES
 Do While Len(Filename) > 0  'IF NEXT FILE EXISTS THEN
    Set wbk = Workbooks.Open(Path & Filename)
    For Each ws In wbk.Worksheets
            ws.Copy AFTER:=wb.Sheets(wb.Sheets.Count)
    Next ws
    wbk.Close True
    Filename = Dir
Loop
MsgBox " FILES HAVE BEEN PROCESSED"
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Hi Michael,

Thanks for that. Is there anything else in there I need to add except for

Code:
[COLOR=#333333]Path = "D:\Temp\TESTING\" ' CHANGE TO SUIT[/COLOR]
?

I run the macro and the message "files have been processed" comes up but the no sheets have been added
 
Upvote 0
Are they "xls" files ??
If not you will need to change the file extension in this line
Code:
Filename = Dir(Path & "*.xls")
 
Upvote 0
Okay well change the line to xlsx
Code:
Filename = Dir(Path & "*.xlsx")
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,202
Members
448,554
Latest member
Gleisner2

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
Back
Top