How to copy a single tab from a workbook into a master workbook using VBA on excel

Question

I'm trying to pull one tab into a master workbook from a number of workbooks in a specified folder. so far this is what I have:

Sub GetSheets()
Path = "D:\APQP\APQP\Open Projects\"
Filename = Dir(Path & "*.xlsx")
  Do While Filename <> ""
  Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
     For Each Sheet In ActiveWorkbook.Sheets
     Sheets("5-Phase").Select
     Sheets("5-Phase").Copy Before:=ThisWorkbook.Sheets(1)
  Next
     Workbooks(Filename).Close
     Filename = Dir()
  Loop
End Sub

Right now when I run it, it populates the master workbook with 50 of the tabs from the first wookbook in the folder instead of coping the tab and moving on to the next workbook and coping the tab in that workbook. Any help would be great.

Your "For Each" will grab each sheet in the workbook you open, but then copy 5-Phase, so it's copying 5-Phase for every sheet in the every workbook. Remove the "For" loop and that should solve the problem — PKatona

tigeravatar tigeravatar · Accepted Answer · 2016-01-15T17:05:52

You have two major problems with your code. The For loop is unnecessary and you aren't working with the opened workbook. Something like this should work for you:

Sub GetSheets()

    Dim wb As Workbook
    Dim sPath As String
    Dim sFileName As String

    Set wb = ThisWorkbook
    sPath = "D:\APQP\APQP\Open Projects\"
    sFileName = Dir(sPath & "*.xlsx")

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    On Error Resume Next
    Do While Len(sFileName) > 0
        With Workbooks.Open(sPath & sFileName, ReadOnly:=True)
            .Sheets("5-Phase").Copy Before:=wb.Sheets(1)
            .Close False
        End With
        sFileName = Dir()
    Loop
    On Error GoTo 0

    Application.ScreenUpdating = True
    Application.EnableEvents = True

End Sub

How to copy a single tab from a workbook into a master workbook using VBA on excel

1 Answers