Merge multiple workbooks

B

bmrsalgas

New Member
Joined
Aug 11, 2017
Messages
26
Need help with vba code that should merge multiple workbooks into one workbook from a folder that the user chooses, but it should only merge the 1st sheet of each workbook.

I found this code only it does half of what I need but I'm clueless about the rest.

Scheme for macro working:

1st - Ask user the location folder of all workbooks to merge

2nd - merge the first sheet of all of the workbooks on the folder into to the MAIN workbook (where I run the macro with a cute button)


The code that I found online.

Code: 
[COLOR=#101094][FONT=inherit]Option[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Explicit[/FONT][/COLOR]<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; white-space: inherit;">[COLOR=#303336][FONT=inherit]
[/FONT][/COLOR][COLOR=#101094][FONT=inherit]Sub[/FONT][/COLOR][COLOR=#303336][FONT=inherit] GetSheets[/FONT][/COLOR][COLOR=#303336][FONT=inherit]()[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
    [/FONT][/COLOR][COLOR=#101094][FONT=inherit]Dim[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Path [/FONT][/COLOR][COLOR=#101094][FONT=inherit]As[/FONT][/COLOR][COLOR=#303336][FONT=inherit] [/FONT][/COLOR][COLOR=#101094][FONT=inherit]String[/FONT][/COLOR][COLOR=#303336][FONT=inherit],[/FONT][/COLOR][COLOR=#303336][FONT=inherit] fileName [/FONT][/COLOR][COLOR=#101094][FONT=inherit]As[/FONT][/COLOR][COLOR=#303336][FONT=inherit] [/FONT][/COLOR][COLOR=#101094][FONT=inherit]String[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
    [/FONT][/COLOR][COLOR=#101094][FONT=inherit]Dim[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Sht [/FONT][/COLOR][COLOR=#101094][FONT=inherit]As[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Worksheet

    Path [/FONT][/COLOR][COLOR=#303336][FONT=inherit]=[/FONT][/COLOR][COLOR=#303336][FONT=inherit] [/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]"\Users\myname\Documenten\Test\"[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
    fileName [/FONT][/COLOR][COLOR=#303336][FONT=inherit]=[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Dir[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#303336][FONT=inherit]Path [/FONT][/COLOR][COLOR=#303336][FONT=inherit]&[/FONT][/COLOR][COLOR=#303336][FONT=inherit] [/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]"*.xls"[/FONT][/COLOR][COLOR=#303336][FONT=inherit])[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
    [/FONT][/COLOR][COLOR=#101094][FONT=inherit]Do[/FONT][/COLOR][COLOR=#303336][FONT=inherit] [/FONT][/COLOR][COLOR=#101094][FONT=inherit]While[/FONT][/COLOR][COLOR=#303336][FONT=inherit] fileName [/FONT][/COLOR][COLOR=#303336][FONT=inherit]<>[/FONT][/COLOR][COLOR=#303336][FONT=inherit] [/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]""[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
        Workbooks[/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Open fileName[/FONT][/COLOR][COLOR=#303336][FONT=inherit]:=[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Path [/FONT][/COLOR][COLOR=#303336][FONT=inherit]&[/FONT][/COLOR][COLOR=#303336][FONT=inherit] fileName[/FONT][/COLOR][COLOR=#303336][FONT=inherit],[/FONT][/COLOR][COLOR=#303336][FONT=inherit] [/FONT][/COLOR][COLOR=#101094][FONT=inherit]ReadOnly[/FONT][/COLOR][COLOR=#303336][FONT=inherit]:=[/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]True[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
        [/FONT][/COLOR][COLOR=#101094][FONT=inherit]With[/FONT][/COLOR][COLOR=#303336][FONT=inherit] ActiveWorkbook
            [/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Worksheets[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]1[/FONT][/COLOR][COLOR=#303336][FONT=inherit]).[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Copy After[/FONT][/COLOR][COLOR=#303336][FONT=inherit]:=[/FONT][/COLOR][COLOR=#303336][FONT=inherit]ThisWorkbook[/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Sheets[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]1[/FONT][/COLOR][COLOR=#303336][FONT=inherit])[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
            ThisWorkbook[/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Sheets[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]2[/FONT][/COLOR][COLOR=#303336][FONT=inherit]).[/FONT][/COLOR][COLOR=#303336][FONT=inherit]name [/FONT][/COLOR][COLOR=#303336][FONT=inherit]=[/FONT][/COLOR][COLOR=#303336][FONT=inherit] [/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#303336][FONT=inherit]name
        [/FONT][/COLOR][COLOR=#101094][FONT=inherit]End[/FONT][/COLOR][COLOR=#303336][FONT=inherit] [/FONT][/COLOR][COLOR=#101094][FONT=inherit]With[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
        ActiveWorkbook[/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Close
        fileName [/FONT][/COLOR][COLOR=#303336][FONT=inherit]=[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Dir[/FONT][/COLOR][COLOR=#303336][FONT=inherit]()[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
    [/FONT][/COLOR][COLOR=#101094][FONT=inherit]Loop[/FONT][/COLOR][COLOR=#303336][FONT=inherit] [/FONT][/COLOR]</code>[COLOR=#101094][FONT=inherit]End[/FONT][/COLOR][COLOR=#303336][FONT=inherit] [/FONT][/COLOR][COLOR=#101094][FONT=inherit]Sub[/FONT][/COLOR]
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Sort by date Sort by votes
merge the first sheet of all of the workbooks on the folder into to the MAIN workbook
Click to expand...
Do you mean that all the info should be copied onto 1 sheet in main? If so what is the name of the sheet?
 
Upvote 0
Unfortunately I have discovered that I am unable to help.
I was going to use FileDialog(msoFileDialogFolderPicker), but it doesn't seem to work for me.
 
Upvote 0
are you trying to aggregate to one sheet in the workbook or add a new sheet for each imported workbook
 
Upvote 0
alright, I am assuming you are a little familiar with how to run VBE since you posted code;
--This will ask you what Workbooks you would like to import - the initial directory starts off in the folder where ever you have the workbook save you put this code in

For whatever workbooks you select to import it will take the first sheet of each (including and blank spaces) and dump them in your MAIN workbook on the first sheet >>the workbook you post the code below in
--each time it does it won't overwrite either, it will go to the last row occupied/UsedRange

Since macro buttons in a spreadsheet are stupid I also included the below (totally kidding, just trying to give you a hard time; you can assign this to a button if you want)
>>it is a right click menu, so when you right click, they'll be a new sub menu where you can click to run it

>>After you have pasted the code, save the workbook, close it, and reopen it to engage the right click submenu.
>>>you could also run the Submenu macro to engage it, as well.

let me know if somethings not working in it


so this part need to go in ThisWorkbook in the visual basic editor

Code: 
Option Explicit


Sub Workbook_Open()
    Call Submenu
End Sub
Sub Workbook_Close()
    Call DeleteSubmenu
End Sub


and paste this in a inserted or new Module in the visual basic editor

Code: 
Option Explicit
Sub Submenu()
    Dim Bar As CommandBar
    Dim NewMenu As CommandBarControl
    Dim NewSubmenu As CommandBarButton
        Set Bar = CommandBars("Cell")
        Set NewMenu = Bar.Controls.Add(Type:=msoControlPopup, before:=1, temporary:=True)
        NewMenu.Caption = "Mc&Nuggets"
        Bar.Controls(2).BeginGroup = True
    Set NewSubmenu = NewMenu.Controls.Add(Type:=msoControlButton)
    With NewSubmenu
        .FaceId = 266
        .Caption = "&Aggregation"
        .OnAction = "Aggregation"
    End With
End Sub
Sub DeleteSubmenu()
    On Error Resume Next
    CommandBars("Cell").Controls("Mc&Nuggets").Delete
End Sub
Sub Aggregation()
    Dim MasterWorkbook As Workbook
        Set MasterWorkbook = ThisWorkbook
    Dim iWorkbook As Workbook
    Dim Open_iWorkbook As Variant
    Dim x As Long
    Dim y As Long
    Dim x1 As Long
    Dim y1 As Long
        Application.DisplayAlerts = False
        Application.AskToUpdateLinks = False
        Application.ScreenUpdating = False
        ChDir ActiveWorkbook.Path
        Open_iWorkbook = Application.GetOpenFilename(filefilter:="Excel Workbooks(*.xlsx; *xlsm, *.xlsx; *xlsm", _
                        Title:="Import File Select", MultiSelect:=True)
                        On Error Resume Next
            For x = LBound(Open_iWorkbook) To UBound(Open_iWorkbook)
                Set iWorkbook = Workbooks.Open(Open_iWorkbook(x))
                    x1 = iWorkbook.Worksheets(1).Range("A1").SpecialCells(xlCellTypeLastCell).Row
                    y1 = iWorkbook.Worksheets(1).Range("A1").SpecialCells(xlCellTypeLastCell).Column
                    With iWorkbook.Worksheets(1)
                        .Range(Cells(1, 1), Cells(x1, y1)).Copy
                    End With
                    With MasterWorkbook.Worksheets(1)
                        y = Cells(Rows.Count, 1).End(xlUp).Row + 1
                        .Cells(y, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _
                                    Transpose:=False
                        .Cells(y, 1).PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, _
                                    Transpose:=False
                        .Cells(y, 1).pastespeical Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, _
                                    Transpose:=False
                    End With
                    Application.CutCopyMode = False
                    iWorkbook.Close savechanges:=False
            Next x
        Application.DisplayAlerts = True
        Application.AskToUpdateLinks = True
        Application.ScreenUpdating = True
End Sub
 
Upvote 0
bsquad said:
alright, I am assuming you are a little familiar with how to run VBE since you posted code;
--This will ask you what Workbooks you would like to import - the initial directory starts off in the folder where ever you have the workbook save you put this code in

For whatever workbooks you select to import it will take the first sheet of each (including and blank spaces) and dump them in your MAIN workbook on the first sheet >>the workbook you post the code below in
--each time it does it won't overwrite either, it will go to the last row occupied/UsedRange

Since macro buttons in a spreadsheet are stupid I also included the below (totally kidding, just trying to give you a hard time; you can assign this to a button if you want)
>>it is a right click menu, so when you right click, they'll be a new sub menu where you can click to run it

>>After you have pasted the code, save the workbook, close it, and reopen it to engage the right click submenu.
>>>you could also run the Submenu macro to engage it, as well.

let me know if somethings not working in it


so this part need to go in ThisWorkbook in the visual basic editor

Code: 
Option Explicit


Sub Workbook_Open()
    Call Submenu
End Sub
Sub Workbook_Close()
    Call DeleteSubmenu
End Sub


and paste this in a inserted or new Module in the visual basic editor

Code: 
Option Explicit
Sub Submenu()
    Dim Bar As CommandBar
    Dim NewMenu As CommandBarControl
    Dim NewSubmenu As CommandBarButton
        Set Bar = CommandBars("Cell")
        Set NewMenu = Bar.Controls.Add(Type:=msoControlPopup, before:=1, temporary:=True)
        NewMenu.Caption = "Mc&Nuggets"
        Bar.Controls(2).BeginGroup = True
    Set NewSubmenu = NewMenu.Controls.Add(Type:=msoControlButton)
    With NewSubmenu
        .FaceId = 266
        .Caption = "&Aggregation"
        .OnAction = "Aggregation"
    End With
End Sub
Sub DeleteSubmenu()
    On Error Resume Next
    CommandBars("Cell").Controls("Mc&Nuggets").Delete
End Sub
Sub Aggregation()
    Dim MasterWorkbook As Workbook
        Set MasterWorkbook = ThisWorkbook
    Dim iWorkbook As Workbook
    Dim Open_iWorkbook As Variant
    Dim x As Long
    Dim y As Long
    Dim x1 As Long
    Dim y1 As Long
        Application.DisplayAlerts = False
        Application.AskToUpdateLinks = False
        Application.ScreenUpdating = False
        ChDir ActiveWorkbook.Path
        Open_iWorkbook = Application.GetOpenFilename(filefilter:="Excel Workbooks(*.xlsx; *xlsm, *.xlsx; *xlsm", _
                        Title:="Import File Select", MultiSelect:=True)
                        On Error Resume Next
            For x = LBound(Open_iWorkbook) To UBound(Open_iWorkbook)
                Set iWorkbook = Workbooks.Open(Open_iWorkbook(x))
                    x1 = iWorkbook.Worksheets(1).Range("A1").SpecialCells(xlCellTypeLastCell).Row
                    y1 = iWorkbook.Worksheets(1).Range("A1").SpecialCells(xlCellTypeLastCell).Column
                    With iWorkbook.Worksheets(1)
                        .Range(Cells(1, 1), Cells(x1, y1)).Copy
                    End With
                    With MasterWorkbook.Worksheets(1)
                        y = Cells(Rows.Count, 1).End(xlUp).Row + 1
                        .Cells(y, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _
                                    Transpose:=False
                        .Cells(y, 1).PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, _
                                    Transpose:=False
                        .Cells(y, 1).pastespeical Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, _
                                    Transpose:=False
                    End With
                    Application.CutCopyMode = False
                    iWorkbook.Close savechanges:=False
            Next x
        Application.DisplayAlerts = True
        Application.AskToUpdateLinks = True
        Application.ScreenUpdating = True
End Sub
Click to expand...

The code works fine but.

It doesn't copy all of the workbooks that I choose. And can it be possible to import the data without the heading?
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
VBA - Save each sheet as new workbook with sheet name ( choose all sheets file from a folder & save the extracted workbooks in a folder )
Replies
9
Views
879
ceasar47
C
S
  • Solved
VBA Code to select a variable folder path, find multiple .xls then copy same named worksheets into new workbook.
Replies
4
Views
465
SteveD01
S
M
  • Question
VBA help required in creating multiple workbooks from one workbook.
Replies
5
Views
304
jolivanes
jolivanes
R
  • Solved
combining csv workbooks to single sheet - vba works but need help adjusting
Replies
4
Views
452
Alex Blakenburg
A
A
  • Solved
VBA - link to [any] the current user's desktop
Replies
4
Views
630
AV_Geek
A

Forum statistics

Threads
1,215,322
Messages
6,124,241
Members
449,149
Latest member
mwdbActuary

Share this page

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