Using VBA scripts to Combine multiple workbooks of single worksheet to a single workbook of multiple worksheets

Excel_beginner

New Member
Joined
Jan 15, 2008
Messages
4
I am a beginner to Excel and VBA, can somebody show me a few lines of scripts and instructions how to use VBA scripts to combine multiple Excel xls Files (which contain single worksheet) into a single Excel file of multiple worksheets?

Can somebody also suggest a good book with examples I can start to learn to solve these kinds of problems?

Thanks very much

Excel_beginner :confused:
 
Hi Anshul,

I neglected to mention, you only run get_folder_path... it will use the other sub and function in the code.

I have no clue whatsoever why/how Excel would quit completely without seeming to do anything... Try closing out of Excel completely so that no Excel window is open, then create a new workbook and delete sheets until there is onlly one sheet in it. Then, put the code in that workbook and run the code. You will need all the books that you want to compile to be in one folder, with no other workbooks in that folder. The results should compile in the new book that contains the code.

Are these .xls or are they .xlsx or some other format?

Tai
 
Upvote 0

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
Hi,

I am trying a similar code where in I want to copy a selected range of cells from a sheet in source workbook to specified cells in a sheet in destination workbook.

Here is my code.
Dim SourceWS, DestWS As Worksheet
Dim STCRowStart, STCColStart, STCRowEnd, STCColEnd, DestTCRow, DestTCCol As Integer
Dim SWB, DWB As Workbook
Dim CopyRange As Range

'Open Master Sheet
Set DWB = Workbooks.Open("Test.xls")

'Fill Step-wise Objective Sheet
'Set the selection area for copy-pasting
STCRowStart = 2
STCColStart = 2
STCRowEnd = 2
While (Sheet7.Cells(STCRowEnd, 1) <> Empty)
STCRowEnd = STCRowEnd + 1
Wend
STCRowEnd = STCRowEnd - 1
STCColEnd = 51
If STCRowStart <> STCRowEnd Then
Set CopyRange = Sheet7.Range(Cells(STCRowStart, STCColStart), Cells(STCRowEnd, STCColEnd))
CopyRange.Copy
'Set the destination row where data needs to be pasted
DestTCRow = 2
While (DWB.Sheets(5).Cells(DestTCRow, 1) <> Empty)
DestTCRow = DestTCRow + 1
Wend
DestTCCol = 1
Paste (DWB.Sheets(5).Cells(DestTCRow, DestTCCol))
End If
End Sub


I am facing an error in the line marked in red.
The error is "Application-defined or Object-defined error"

Could you please help me rectifying this?

Thanks,
Chandan
 
Upvote 0
Hi Chandan,

What does Sheet7 refer to? In order for that to work, it needs to be referring to the *VBA* code name Sheet7 (which could be named anything on the Excel tab but shows up as Sheet7 in the VBE), not the tab that is called Sheet7 within Excel... Maybe either Sheets(7) or Sheets("Sheet7") is what you meant to use? The first refers to the 7th sheet in the active book, the second refers to the sheet (in the active book) named "Sheet7" in Excel.

Hope that helps...

Tai

edit: I see on looking a little closer, that you used Sheet7 successfully higher up in the code - I guess maybe that's not the issue.
 
Last edited:
Upvote 0
hi i hope someone can help me with this. I used this code posted by
schielrn . It is exactly what i need. However, i get an error with

Code:
Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))

it says "Object variable or With block variable not set."

I notice i get this error if one of the workbook im trying to merge contains more than one sheet.

Some of my workbook contains more than one worksheet. I only need to copy the first sheet.

Heres the whole code:
Code:
'Description: Combines all files in a folder to a master file.
Option Explicit
Public strPath As String
Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
                                     Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
                                   Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Function GetDirectory(Optional Msg) As String
    Dim bInfo As BROWSEINFO
    Dim path As String
    Dim r As Long, x As Long, pos As Integer
    '   Root folder = Desktop
    bInfo.pidlRoot = 0&
    '   Title in the dialog
    If IsMissing(Msg) Then
        bInfo.lpszTitle = "Select a folder."
    Else
        bInfo.lpszTitle = Msg
    End If
    '   Type of directory to return
    bInfo.ulFlags = &H1
    '   Display the dialog
    x = SHBrowseForFolder(bInfo)
    '   Parse the result
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal path)
    If r Then
        pos = InStr(path, Chr$(0))
        GetDirectory = Left(path, pos - 1)
    Else
        GetDirectory = ""
    End If
End Function
Sub MergeFiles()
    Dim path As String, ThisWB As String, lngFilecounter As Long
    Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
    Dim Filename As String, Wkb As Workbook
    Dim CopyRng As Range, Dest As Range
    Dim RowofCopySheet As Integer
    RowofCopySheet = 2 ' Row to start on in the sheets you are copying from
    ThisWB = ActiveWorkbook.Name
 
    path = GetDirectory("Select a folder containing Excel files you want to merge")
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Set shtDest = ActiveWorkbook.Sheets(1)
    Filename = Dir(path & "\*.xls", vbNormal)
    If Len(Filename) = 0 Then Exit Sub
    Do Until Filename = vbNullString
        If Not Filename = ThisWB Then
            Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
            'Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1))
          '  Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
            Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
            CopyRng.Copy Dest
            Wkb.Close False
        End If
 
        Filename = Dir()
    Loop
    Range("A1").Select
 
    Application.EnableEvents = True
    Application.ScreenUpdating = True
 
    MsgBox "Done!"
End Sub
 
Upvote 0
Hi all, I'm completely new to this forum, but have been reading along for a while. I'm pretty good with Excel, but suck at VBA. I've been working with information from this forum for a while, but never found the need to post a question, up till today. I have copied and adjusted the code from this topic, as I need to merge the data from several Excel files into 1 master file.

The following are the criteria, which I still cannot solve in this code:

- It should run automatically when I open the master sheet
- It should delete the previous data that was imported in the sheet
- It should automatically import the Excel files from a fixed location (so no pop-up to ask for the location
- It should import all files from the subdirectories of this location. This last thing was done correctly in the code I found here: http://msdn.microsoft.com/en-us/library/cc837974(v=office.12).aspx#MergeDataFromMultipleWorkbooks_MergingRangefromAllWorkbooks But this generates a new workbook

Could somebody please help me with these last minor adjustments?

This is the code I have now:

Code:
Option Explicit
Public strPath As String
Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
                                     Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
                                   Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Function GetDirectory(Optional Msg) As String
    Dim bInfo As BROWSEINFO
    Dim path As String
    Dim r As Long, x As Long, pos As Integer
    '   Root folder = Desktop
    bInfo.pidlRoot = 0&
    '   Title in the dialog
    If IsMissing(Msg) Then
        bInfo.lpszTitle = "Select a folder."
    Else
        bInfo.lpszTitle = Msg
    End If
    '   Type of directory to return
    bInfo.ulFlags = &H1
    '   Display the dialog
    x = SHBrowseForFolder(bInfo)
    '   Parse the result
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal path)
    If r Then
        pos = InStr(path, Chr$(0))
        GetDirectory = Left(path, pos - 1)
    Else
        GetDirectory = ""
    End If
End Function
'Description: Combines all files in a folder to a master file.
Sub MergeFiles()
Dim path As String, ThisWB As String, lngFilecounter As Long
Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
Dim Filename As String, Wkb As Workbook
Dim CopyRng As Range, Dest As Range
Dim RowofCopySheet As Integer

RowofCopySheet = 2 ' Row to start on in the sheets you are copying from

ThisWB = ActiveWorkbook.Name

path = GetDirectory("Select a folder containing Excel files you want to merge")

Application.EnableEvents = False
Application.ScreenUpdating = False

Set shtDest = ActiveWorkbook.Sheets(1)
Filename = Dir(path & "\*.xls", vbNormal)
If Len(Filename) = 0 Then Exit Sub
Do Until Filename = vbNullString
If Not Filename = ThisWB Then
Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
CopyRng.Copy Dest
Wkb.Close False
End If

Filename = Dir()
Loop

Range("A1").Select

Application.EnableEvents = True
Application.ScreenUpdating = True

MsgBox "Done!"
End Sub
 
Upvote 0
You don't have a file path in the macro.

I'm not sure what you mean with that. Do you mean that I need to add a file path in the code, so it will not show a pop-up asking for the directory? If so, that is exactly my question. I don't know how to build these code's in VBA. Can you help me to point out where to place this in the code and how?

Do you know how to achieve the other functionalities?
 
Upvote 0
Code:
path = GetDirectory("Select a folder containing Excel files you want to merge")

Needs to be something like
Code:
path = "C:\Users\What\Ever\You Need"
 
Upvote 0
Code:
path = GetDirectory("Select a folder containing Excel files you want to merge")

Needs to be something like
Code:
path = "C:\Users\What\Ever\You Need"

Yes, that seems to work when the files are all in the same folder. Thanks. Although I'm looking for a way to get all Excel file data from all subfolders. The starting point could also be the code which you can find on the website I posted earlier. This also links to this site: http://www.rondebruin.nl/fso.htm which shows how to include subfolders. However, I'm not able to understand it completely.

Ron de Bruin also has a tool for non-VBA experienced users to use, but it has the following mismatches with what I want:
- Does not put the data in an existing master sheet, but opens a new file
- Does not paste with cell format and formulas, instead it pastes "values"
- Does not update automatically

Could anybody help me adjust / build the correct code?
 
Upvote 0

Forum statistics

Threads
1,223,923
Messages
6,175,401
Members
452,640
Latest member
steveridge

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