VBA: Combine multiple workbook into one

[FryGirl]

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?​

[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]

 

[Fluff]

How about

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

 

[FryGirl]

Hi Fluff,

That still closed the source workbook, Book1.xlsm, and nothing was copied.

 

[Fluff]

Ok, misunderstood what was happening, try

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

 

[FryGirl]

Perfect and thank you very much. I see it now. It's the wb.name part I was not getting.

 

[Fluff]

Glad to help & thanks for the feedback