VBA Code to merge several workbooks into one

need help to code as I have several workbooks that I need to consolidate into one workbook.  Any help is appreciated.
Natashar7Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Ryan ChongCommented:
you may try to refer to this article and customize accordingly.

Merging Data from Multiple Workbooks into a Summary Workbook in Excel 2010
https://msdn.microsoft.com/en-us/library/office/gg549168(v=office.14).aspx
0
Roy CoxGroup Finance ManagerCommented:
Here's some code that can be adapted, post back if you need help using it
Option Explicit



'---------------------------------------------------------------------------------------
' Module    : Combine Data
' Author    : Roy Cox (royUK)
' Website   : for more examples and Excel Consulting
' Date      : 19/11/2011
' Purpose   : Combine data from several workbooks
' Disclaimer: Disclaimer; This code is offered as is with no guarantees. You may use it in your
'             projects but please leave this header intact.
 
'---------------------------------------------------------------------------------------



Sub CombineData()
    Dim oWbk As Workbook
    Dim rRng As Range
    Dim rToCopy As Range
    Dim rNextCl As Range
    Dim lCount As Long
    Dim bHeaders As Boolean
    Dim sFil As String
    Dim sPath As String

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
        '   On Error GoTo exithandler
        ' assumes workbooks are in a sub folder named "Data"
        sPath = ThisWorkbook.Path & Application.PathSeparator & "Data"
        ChDir sPath
        sFil = Dir("*.xl**")    'file type
        Do While sFil <> ""    'will start LOOP until all files in folder sPath have been looped through

            With ThisWorkbook.Worksheets(1)
                Set rRng = .Range("A1").CurrentRegion
                If rRng.Cells.Count = 0 Then
                    'no data in master sheet
                    bHeaders = False
                Else: bHeaders = True
                End If

                Set oWbk = Workbooks.Open(sPath & Application.PathSeparator & sFil)    'opens the file
                'A1 must be within the data, if not amend the Range below
                Set rToCopy = oWbk.ActiveSheet.Range("A1").CurrentRegion
                If Not bHeaders Then
                    Set rNextCl = .Cells(1, 1)
                    bHeaders = True
                Else: Set rNextCl = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
                    'headers exist so don't copy
                    Set rToCopy = rToCopy.Offset(1, 0).Resize(rToCopy.Rows.Count - 1, _
                                                              rToCopy.Columns.Count)
                End If
                rToCopy.Copy rNextCl
            End With
            oWbk.Close False     'close source workbook
            sFil = Dir
        Loop    ' End of LOOP
        'sort to remove empty rows
        Set rRng = ThisWorkbook.Worksheets(1).UsedRange
        rRng.Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
                  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                  DataOption1:=xlSortNormal
exithandler:
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
End Sub

Open in new window

0
Natashar7Author Commented:
Thank you Roy Cox.  Where does it specify the path to pick the files and merge them together?
0
Cloud Class® Course: Microsoft Azure 2017

Azure has a changed a lot since it was originally introduce by adding new services and features. Do you know everything you need to about Azure? This course will teach you about the Azure App Service, monitoring and application insights, DevOps, and Team Services.

Roy CoxGroup Finance ManagerCommented:
This is the path, you need to amend it to point to the folder that contains your filrs

 ' assumes workbooks are in a sub folder named "Data"
        sPath = ThisWorkbook.Path & Application.PathSeparator & "Data"

Open in new window

0
Natashar7Author Commented:
Thank you!  Can you please tell me exactly if this is correct
do I eliminate the Spath?
is this correct?

c:\trial.xls
0
Roy CoxGroup Finance ManagerCommented:
You replace the defined sPath line to the path of your workbooks. In the example the path is subfolder named Data within the same folder as the workbook containing the code.
0
Natashar7Author Commented:
I tried Roy_Cox code didn't work, but the 1st code posted worked somewhat.  but getting an error on Set DesRange = "SummarySheet.Range("A" & NRow)  Can someone help me to see what is the issue?
Thanks
0
Roy CoxGroup Finance ManagerCommented:
Strange that my code didn't work, I've been using it successfully for years. Attach the workbook with the code in and a sample of the file to import
0
Natashar7Author Commented:
Attached are the two files the source data has more columns but I just copied a few.  the path they are located is c:users\test\filename is cash

Thank you for your help!
Master.xlsm
Cash.xlsx
0
Roy CoxGroup Finance ManagerCommented:
I see you are using Tables. I'll amend the code and post a workbook later.
0
Natashar7Author Commented:
Great Thank you!
0
Roy CoxGroup Finance ManagerCommented:
This works fine for me.

Are you cash files in a separate folder called filename as you in the path you provide and master in another folder?
Master.xlsm
0
Natashar7Author Commented:
The source files are in the folder c:\users\Desktop\Test Folder

The test folder has all the source files they all have different file names but they all begin with sheet

The Masterfolder to copy the data I can put it in the same folder.
0
Roy CoxGroup Finance ManagerCommented:
This is the path you posted previously

 c:users\test\

In the code you need to change it to the one you have just posted

c:\users\Desktop\Test Folder

Don't put the master file in the same folder.
0
Natashar7Author Commented:
ok Thank you!  I will try it and let you know Thanks for your help and hard work.
0
Natashar7Author Commented:
I am getting an error on ChDir Spath?  What should I put here?
0
Roy CoxGroup Finance ManagerCommented:
What value have you assigned to sPath, it's a variable and you do not need to change that line. You should have change sPath = to the path tghat contains the data files as I said in my last post
0
Natashar7Author Commented:
First Thank you for the prompt response.

SPath = "c:users\Cash\Test"  (Test is the folder not the file name is that ok)

the next line is

ChDir sPath   this is the line I am getting an error
0
Roy CoxGroup Finance ManagerCommented:
I don't think that your path is correct, it should have the user name in it

 "c:users\user name here\Cash\Test"

Right click on the folder that you are using and select Properties. This will open a dialog and you can copy the Location from that dialog. Paste it into the code and add  \cash
0
Natashar7Author Commented:
I am really confused that is how I have it

"c:users\AN\Test"  I have changed the file path and still not working.  The files are saved in the Test folder and the file names are starting with the word Sheet
0
Natashar7Author Commented:
The error I am getting is at the CHDir sPath.  Are you able to modify the error on the first code from Ryan Chong because that works but getting an error on but getting an error on Set DesRange = "SummarySheet.Range("A" & NRow)  

thanks
0
Natashar7Author Commented:
On the Microsoft code I am getting an error runtime error 1004 Method Range of object worksheet failed.   When I debug
Set DestRange = SummarySheet.Range("A" & NRow)

are you able to see why I am getting an error on this line thanks
0
Roy CoxGroup Finance ManagerCommented:
That is not my code. The example that I posted works fine for me all you need to do is enter the coreect path to the folder
0
Natashar7Author Commented:
I have changed the path to this "c:users\AN\Test"  I have changed the file path and still not working.  The files are saved in the Test folder and the file names are starting with the word Sheet

the error I am getting is CHDir sPath in your code
0
Roy CoxGroup Finance ManagerCommented:
So what value is sPath when you hover yje cursor over it after the error occurs?
0
Natashar7Author Commented:
ChDir sPath is highlighted
0
Natashar7Author Commented:
spath="c:users\AN\Test"
0
Roy CoxGroup Finance ManagerCommented:
I;ve just run the code again on my test folder and the data is transferred perfectly. Is AN the user name on the computer?
0
Natashar7Author Commented:
AN is a sub folder
0
Natashar7Author Commented:
I created a subfolder in C:\users folder and then another under AN for test
0
Natashar7Author Commented:
even if I change the folder it still doesn't work
0
Natashar7Author Commented:
Test is a folder name should I identify the file name?  The filenames will all be different but all will start with Sheet?
0
Roy CoxGroup Finance ManagerCommented:
Your code should have the user name in the Path. This is the path to my test folder

      sPath = "C:\Users\Roy Cox\Desktop\TEST\Data"

It points to Users -> User Name->Desktop

The code loops through all the excel files in the folder

In your Path there is no user name if AN refers to a folder.
0
Natashar7Author Commented:
I changed it how you have it to my user name desktop etc and now getting the next error

rRng.Sort Key1:=.Range("A2", order1:=xlAscending, header:=xlGuess,_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
0
Roy CoxGroup Finance ManagerCommented:
Just delete that code it isn't necessary for your data, although it works for mr
0
Natashar7Author Commented:
it worked perfect Thank you so much.  Sorry for so many questions.
0
Roy CoxGroup Finance ManagerCommented:
We got there in the end!
1
Natashar7Author Commented:
Thank you!
0
Natashar7Author Commented:
Hi Roy Cox

if there are more than one file it doesn't append them do you know why.  It works if there is only one file?
0
Roy CoxGroup Finance ManagerCommented:
Slight amendment to the code

Option Explicit
'---------------------------------------------------------------------------------------
' Module    : Combine Data
' Author    : Roy Cox (royUK)
' Website   : for more examples and Excel Consulting
' Date      : 19/11/2011
' Purpose   : Combine data from several workbooks
' Disclaimer: Disclaimer; This code is offered as is with no guarantees. You may use it in your
'             projects but please leave this header intact.

'---------------------------------------------------------------------------------------



Sub CombineData()
    Dim oWbk As Workbook
    Dim rRng As Range
    Dim rToCopy As Range
    Dim rNextCl As Range
    Dim lCount As Long
    Dim bHeaders As Boolean
    Dim sFil As String
    Dim sPath As String

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
        '   On Error GoTo exithandler
        ''/// this the path that you provided
        sPath = "C:\Users\Roy Cox\Desktop\TEST\Data"

        ChDir sPath
        sFil = Dir("*.xl**")    ''///file type
        Do While sFil <> ""    ''///will start LOOP until all files in folder sPath have been looped through

            With ThisWorkbook.Worksheets(1)
                Set rRng = .Range("A2").CurrentRegion

                If rRng Is Nothing Then
                    ''///no data in master sheet
                    bHeaders = False
                Else: bHeaders = True
                End If

                Set oWbk = Workbooks.Open(sPath & Application.PathSeparator & sFil)    'opens the file
                ''///A1 must be within the data, if not amend the Range below
                Set rToCopy = oWbk.ActiveSheet.Range("A2").CurrentRegion
               
                If Not bHeaders Then
                    Set rNextCl = .Cells(1, 1)
                    bHeaders = True
                Else: Set rNextCl = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
                    ''///headers exist so don't copy
                    Set rToCopy = rToCopy.Offset(1, 0).Resize(rToCopy.Rows.Count - 1, _
                                                              rToCopy.Columns.Count)
                End If
                rToCopy.Copy rNextCl
            End With
            oWbk.Close False     ''///close source workbook
            sFil = Dir
        Loop    ''/// End of LOOP
        ''///optional - delete if not required
        ''///sort to remove empty rows
        Set rRng = ThisWorkbook.Worksheets(1).UsedRange
        rRng.Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
                  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                  DataOption1:=xlSortNormal
exithandler:
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Natashar7Author Commented:
Hi Roy

I Just tried the new code it works but it also gives me an error when I debug the below is highlighted.  Please let me know where to fix it.  Thanks

rRng.Sort Key1:=.Range("A2"), order1:=XlAscending, Header:=xlGuess,_
OrderCutom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
0
Roy CoxGroup Finance ManagerCommented:
I to;d you in an earlier post to delete that code. it's not necessary for your requirements
0
Martin LissOlder than dirtCommented:
This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.