Link to home
Start Free TrialLog in
Avatar of chima
chima

asked on

MS Excel appending several files

Hello,
I searched the internet for a solution, but could not find one that works.  I do not have MS Query.
And I do not want to use;  copy *.csv ConsolidatedFile.csv  I would have to save every file as a csv (now xlsx files).
I have several excel files, some of these files have several "sheets" to them.
I wish to have file "1" to be consolidated/placed in "sheet1" of the master consolidation file, and file "2" in "sheet2," etc.
This might be easy for xlsx files that have only one sheet.
It could be that for those files that have more than one sheet, they would simply be copied into the next sheet.  This would be acceptable.
Is there an easy way of doing this?  There are too many files to do it manually.
Avatar of Professor J
Professor J

assuming that all of the individual workbooks have only one sheet in them, then use code below

change the mypath to the folder where your workbooks exist

Sub MergeMultiWorkbooks()
    Dim wbDst As Workbook
    Dim wbSrc As Workbook
    Dim wsSrc As Worksheet
    Dim MyPath As String
    Dim strFileName As String

    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    MyPath = "C:\ProfessorJimJam" ' change to suit
    Set wbDst = Workbooks.Add(xlWBATWorksheet)
    strFileName = Dir(MyPath & "\*.xlsx", vbNormal)

    If Len(strFileName) = 0 Then Exit Sub

    Do Until strFileName = ""

            Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFileName)

            Set wsSrc = wbSrc.Worksheets(1)

            wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)
               wbDst.Worksheets(wbDst.Worksheets.Count).Name = strFileName
           wbSrc.Close False

        strFileName = Dir()

    Loop
    wbDst.Worksheets(1).Delete

    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

Open in new window

SOLUTION
Avatar of ElrondCT
ElrondCT
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of chima

ASKER

ProfessorJimJam and ElrondCT I will try your both of your code.  I am embarrassed to have to ask; how would  I execute these code?
ASKER CERTIFIED SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
No need to be embarrassed; this is the place to learn. This code needs to go in a module, where you can enter VBA (Visual Basic for Applications) code. To open a module, press Alt+F11. You'll see three boxes: in the top left, a Project box; in the bottom left, a Properties box; on the right, a code box.

In the Project box, right-click on the bold line which says "VBAProject" then the name of your worksheet in parentheses. From the context menu, choose Insert, then Module. The code box will change from gray to white. You can now enter code there. Enter the entire macro, which I'll show below combining ProfessorJimJam's original and my additional code to make it less confusing.

Once it's there, and you've adjusted it as needed (note the folder name that needs to be changed at line 11), click anywhere in the macro and press F5 to run it.

One other little complication: If you're using the new format of Excel file (with a .xlsx extension), you'll need to change the extension to .xlsm if you want to save the macro with the worksheet. For security, Excel won't save a macro in a .xlsx file; by changing the extension to .xlsm, you're indicating that you understand there are macros, which can, of course, do all sorts of things, good or bad. If you're using an old format .xls file, you don't have to change its extension.
Sub MergeMultiWorkbooks()
    Dim wbDst As Workbook
    Dim wbSrc As Workbook
    Dim wsSrc As Worksheet
    Dim MyPath As String
    Dim strFileName As String
    Dim iSheet, iSheetCount as Integer

    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    MyPath = "C:\ProfessorJimJam" ' change to suit
    Set wbDst = Workbooks.Add(xlWBATWorksheet)
    strFileName = Dir(MyPath & "\*.xlsx", vbNormal)

    If Len(strFileName) = 0 Then Exit Sub

    Do Until strFileName = ""

            Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFileName)

            iSheetCount = wbsrc.Worksheets.Count
            For iSheet = 1 to iSheetCount 
                Set wsSrc = wbSrc.Worksheets(iSheet)
                wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)
                wbDst.Worksheets(wbDst.Worksheets.Count).Name = strFileName & iSheet
            Next iSheet
           wbSrc.Close False

        strFileName = Dir()

    Loop
    wbDst.Worksheets(1).Delete

    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

                                          

Open in new window

Prof & I were writing simultaneously; I didn't see his message until after I posted mine...
Avatar of chima

ASKER

Professor, I executed your instructions and the result was a merged file with Book1 and Book2.  The only exception was that the merged file got three tab from two files.  I looked at book1 and book2 and both had three tabs with 1s in all 3 tabs of book1 and 2s in all 3 tabs of book2.  I ended up deleting the extra tabs and now I do get one merged file with two tabs;
User generated image
ElrondCT
I created a new xlsm file with your code (which looks to be the same code as that of Prof's code.  I have not done a diff on them), and I changed line 11 to "C:/TEST"  When I do a "Ctrl+q" on this new .xlsm it does not execute the macro.  I appreciate your efforts to teach me, I do have some programming experience with Java, C++, but not with Visual Basic.  I did not get the boxes you mentioned, but I managed to work with what you and Prof wrote.  I will continue to troubleshoot my setup;
User generated imageBook1andBook2.PNG
Avatar of chima

ASKER

Darn book1 and book2 png did not get embedded where I wanted it to be.
if you do not need the extra worksheets in destination workbook from the source workbooks

Then use my very first code that I provided.
Avatar of chima

ASKER

From the "Visual Basic for Application" app I executed "Run" and my xlsm file (with your code) worked.

So why doesn't "Ctrl+q" work from my xlsm file?
Avatar of chima

ASKER

Prof, I'll have to study both sets of code, or try your first set.  Thank you for the help.
Points coming shortly.
Avatar of chima

ASKER

Prof, I tried your EE.xlsm code with the "modified" book1 and book2 and the results are different from your initial book1 and book2.  The tabs on yours where "related/connected" to each other.  In my files the tabs are not.  I say this because your EE.xlsm only worked (picked up) book2 and added the all of the three tabs into the merge file;
User generated image
Avatar of chima

ASKER

Oops! sorry, it does pick book1 also.  So now I have one merged file with 6 tabs/sheets.  That works well.
Avatar of chima

ASKER

The EE.xlsm code generates an error when the file names are larger than 30 characters or so.  Had to rename my files.  Otherwise works well.  Now I will try some much larger files.
You need consider that there is a limitation of maximum char a worksheet name can accept.

It will work with no problem with larger file too.
Avatar of chima

ASKER

Prof, seems to me that if the file can be named as larger as desired, then the code should be able to handled them.  I now have some files with names like;
(Seller) (Non-Energy transaction Type) Non-Energy transaction Sales to (Buyer)
78 characters!
Is there any remedy for this.  I wish not to have to change the names of 1000 files.
There is a remedy to cut short the names to the level of max accepted char in worksheet with code , not manual.
Would that be ok if your workbooks names will appear in appended file as short names?
Avatar of chima

ASKER

Prof, I reckon I have no other choice.  Could this be done with a macro as well?  Unfortunately I would have to rely on you for this as well.
Yes, I will include few more code in the existing code.
Avatar of chima

ASKER

Thank you.  I'll submit another question for the other part.
Chima,

you do not need to open another question, here is the solution for files more than 30 char

Sub MergeMultiWorkbooks()
    Dim wbDst As Workbook
    Dim wbSrc As Workbook
    Dim wsSrc As Worksheet
    Dim MyPath As String
    Dim strFileName As String
   Dim iSheet, iSheetCount As Integer

    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    MyPath = "C:\TEST" ' change to suit
    Set wbDst = Workbooks.Add(xlWBATWorksheet)
    strFileName = Dir(MyPath & "\*.xlsx", vbNormal)

    If Len(strFileName) = 0 Then Exit Sub

    Do Until strFileName = ""

            Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFileName)

    iSheetCount = wbSrc.Worksheets.Count
    For iSheet = 1 To iSheetCount
            Set wsSrc = wbSrc.Worksheets(iSheet)
            wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)
            wbDst.Worksheets(wbDst.Worksheets.Count).Name = Left(strFileName, 20) & iSheet
    Next iSheet

           wbSrc.Close False

        strFileName = Dir()

    Loop
    wbDst.Worksheets(1).Delete

    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

Open in new window

Avatar of chima

ASKER

Prof, I feel that your initial response was/is worth the points I gave to you.  I wanted to give you more for the final code.  Thank you, I'll give it a test run, if I find problems, I'll open another question.
Thanks chima