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:

Some videos you may like

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
19,257
Office Version
  1. 2013
Platform
  1. Windows
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
 

lyyynnnchy

New Member
Joined
Sep 10, 2014
Messages
5
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
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
19,257
Office Version
  1. 2013
Platform
  1. Windows
Are they "xls" files ??
If not you will need to change the file extension in this line
Code:
Filename = Dir(Path & "*.xls")
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
19,257
Office Version
  1. 2013
Platform
  1. Windows
Okay well change the line to xlsx
Code:
Filename = Dir(Path & "*.xlsx")
 

Watch MrExcel Video

Forum statistics

Threads
1,109,001
Messages
5,526,203
Members
409,686
Latest member
Tori83

This Week's Hot Topics

Top