VBA: Combine multiple workbook into one

FryGirl

Well-known Member
Joined
Nov 11, 2008
Messages
1,360
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
This code works great to combine all workbooks from a folder in another master workbook. Problem though, to get it to run I have to remove the
ActiveWorkbook.Close True part because that closes the workbook that I'm running the code from. The destination workbook.

How can I say, if the file in the loop equals the file that we started with, skip it?

Code:
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Sub LoopThroughFolder()[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]    Dim MyFile  As String
    Dim MyDir   As String
    Dim Str     As String
    Dim Wb      As Workbook
    Dim Rws     As Long
    Dim Rng     As Range
    Set Wb = ThisWorkbook
    MyDir = ThisWorkbook.Path & Application.PathSeparator
    MyFile = Dir(MyDir & "*.xlsm")
    ChDir MyDir
    Application.ScreenUpdating = 0
    Application.DisplayAlerts = 0[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]    Do While MyFile <> ""
        Workbooks.Open (MyFile)
        
        With Sheets("Sheet1")
            Rws = .Cells(Rows.Count, "B").End(xlUp).Row
            Set Rng = Range(.Cells(2, 1), .Cells(Rws, 7))
            Rng.Copy Wb.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            [COLOR=#ff0000]ActiveWorkbook.Close True[/COLOR]
        End With
        Application.DisplayAlerts = 1
        MyFile = Dir()
        
    Loop[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]End Sub
[/FONT]
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
How about
Rich (BB code):
Sub LoopThroughFolder()
    Dim MyFile  As String
    Dim MyDir   As String
    Dim Str     As String
    Dim Wb      As Workbook, Wbk2 As Workbook
    Dim Rws     As Long
    Dim Rng     As Range
    Set Wb = ThisWorkbook
    MyDir = ThisWorkbook.Path & Application.PathSeparator
    MyFile = Dir(MyDir & "*.xlsm")
    ChDir MyDir
    Application.ScreenUpdating = 0
    Application.DisplayAlerts = 0
    Do While MyFile <> ""
        Set Wbk2 = Workbooks.Open(MyFile)
        
        With Wbk2.Sheets("Sheet1")
            Rws = .Cells(Rows.Count, "B").End(xlUp).Row
            Set Rng = .Range(.Cells(2, 1), .Cells(Rws, 7))
            Rng.Copy Wb.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            Wbk2.Close False
        End With
        Application.DisplayAlerts = 1
        MyFile = Dir()
        
    Loop
End Sub
 
Upvote 0
Hi Fluff,

That still closed the source workbook, Book1.xlsm, and nothing was copied.
 
Upvote 0
Ok, misunderstood what was happening, try
Rich (BB code):
Sub LoopThroughFolder()
    Dim MyFile  As String
    Dim MyDir   As String
    Dim Str     As String
    Dim Wb      As Workbook, Wbk2 As Workbook
    Dim Rws     As Long
    Dim Rng     As Range
    Set Wb = ThisWorkbook
    MyDir = ThisWorkbook.Path & Application.PathSeparator
    MyFile = Dir(MyDir & "*.xlsm")
    ChDir MyDir
    Application.ScreenUpdating = 0
    Application.DisplayAlerts = 0
    Do While MyFile <> ""
        If MyFile <> Wb.Name Then
            Set Wbk2 = Workbooks.Open(MyFile)
            
            With Wbk2.Sheets("Sheet1")
                Rws = .Cells(Rows.Count, "B").End(xlUp).Row
                Set Rng = .Range(.Cells(2, 1), .Cells(Rws, 7))
                Rng.Copy Wb.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                Wbk2.Close False
            End With
            Application.DisplayAlerts = 1
         End If
        MyFile = Dir()
        
    Loop
End Sub
 
Upvote 0
Perfect and thank you very much. I see it now. It's the wb.name part I was not getting.
 
Upvote 0
Glad to help & thanks for the feedback
 
Upvote 0

Forum statistics

Threads
1,213,557
Messages
6,114,288
Members
448,563
Latest member
MushtaqAli

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