Excel VBA Code to combine multiple Excel files

[Tommy1370]

The following code opens a dialog box for the user to select files. I want it to determine which files to consolidate (using the loop).

'The following code will combine all data into one excel workbook.
Sub CombineFiles_Step1()
'Declare Variables
Dim WorkbookDestination As Workbook
Dim WorkbookSource As Workbook
Dim WorksheetSource As Worksheet
Dim FolderLocation As String
Dim strFilename As String
    
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    'This line will need to be modified depending on location of source folder
    FolderLocation = "C:\Users\Location"
    
    'Set the current directory to the the folder path.
    ChDrive FolderLocation
    ChDir FolderLocation
    
    'Dialog box to determine which files to use. Use ctrl+a to select all files in folder.
    SelectedFiles = Application.GetOpenFilename( _
        filefilter:="Excel Files (*.xls*), *.xls*", MultiSelect:=True)
    
    'Create a new workbook
    Set WorkbookDestination = Workbooks.Add(xlWBATWorksheet)
    strFilename = Dir(FolderLocation & "\*.xls", vbNormal)
    
    'Iterate for each file in folder
    If Len(strFilename) = 0 Then Exit Sub
    
    
    Do Until strFilename = ""
        
            Set WorkbookSource = Workbooks.Open(FileName:=FolderLocation & "\" & strFilename)
            Set WorksheetSource = WorkbookSource.Worksheets(1)
            WorksheetSource.Copy After:=WorkbookDestination.Worksheets(WorkbookDestination.Worksheets.Count)
            WorkbookSource.Close False
        strFilename = Dir()
        
    Loop
    WorkbookDestination.Worksheets(1).Delete
    
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
End Sub

The problems:

1. If I click 'Cancel' in the dialog box it still runs the loop.
2. No matter which files I select it runs the program on all of the files in the folder.

Thanks!

 

[Andrew Poulsom]

Maybe this will help you:

http://dailydoseofexcel.com/archives/2004/06/09/getopenfilename/

 

[Tommy1370]

Thanks Andrew.

Read the article it did privide some helpful tips. However, my main issues is not that I cannot open a file but that my loop continues until there are no files left in the folder...

 

[Andrew Poulsom]

You need to test whether SelectedFiles is an array and if so loop around it rather than using Dir. See the second example in the link I posted.

 

[Tommy1370]

Andrew, thanks! Updated below (seems to be working fine).

'The following code will combine all data into one excel workbook.

Sub CombineFiles()

'Declare Variables
Dim WorkbookDestination As Workbook
Dim WorkbookSource As Workbook
Dim WorksheetSource As Worksheet
Dim FolderLocation As String
Dim strFilename As String
Dim i As Long
    
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    'This line will need to be modified depending on location of source folder
    FolderLocation = "C:\Users\"
    
    'Set the current directory to the the folder path.
    ChDrive FolderLocation
    ChDir FolderLocation
    
    'Dialog box to determine which files to use. Use ctrl+a to select all files in folder.
    SelectedFiles = Application.GetOpenFilename( _
        filefilter:="Excel Files (*.xls*), *.xls*", MultiSelect:=True)
    
    'Create a new workbook
    Set WorkbookDestination = Workbooks.Add(xlWBATWorksheet)
    strFilename = Dir(FolderLocation & "\*.xls", vbNormal)
    
        If IsArray(SelectedFiles) Then
        
        For i = LBound(SelectedFiles) To UBound(SelectedFiles)
            Set WorkbookSource = Workbooks.Open(SelectedFiles(i))
            Set WorksheetSource = WorkbookSource.Worksheets(1)
            WorksheetSource.Copy After:=WorkbookDestination.Worksheets(WorkbookDestination.Worksheets.Count)
            WorkbookSource.Close False
            Next i
            
            End If
            
    WorkbookDestination.Worksheets(1).Delete
       
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
End Sub

 

[Karthik-Excelsior]

Hi,

Thanks for this very useful code. However, i'm trying to modify the code to copy over not just the first sheet's data, but all the sheets in a given workbook. Can you point out what needs to be tweaked in the code?

I believe there has to be For-Loop for the statement : Set WorksheetSource = WorkbookSource.Worksheets(1)

Can you help me fix it?
Thanks,

 

[Andrew Poulsom]

Try replacing:

            Set WorksheetSource = WorkbookSource.Worksheets(1)
            WorksheetSource.Copy After:=WorkbookDestination.Worksheets(WorkbookDestination.Worksheets.Count)

with:

            For Each WorksheetSource In WorkbookSource.Worksheets
                WorksheetSource.Copy After:=WorkbookDestination.Worksheets(WorkbookDestination.Worksheets.Count)
            Next WorksheetSource

 

[Karthik-Excelsior]

Thanks Andrew for the workaround, but i get a Run-time error #1004 which says, "That name is already taken. try a different one"

Any idea, why that would happen?

 

[Andrew Poulsom]

It sounds like a worksheet with the name of the one being copied already exists, although Excel usually deals with that by renaming it.

 

[Karthik-Excelsior]

Cool.. But, for all other practical purposes, this code does exactly what i want. Also, I'm now planning to take it a step forward by searching for a part of the file name, which can get populated in the file open dialog box, which I can then choose for importing. I've been reading up online to see if the "GetOpenFilename" method can help do that. Have you any idea?