Copying sheets from multiple workbooks into ThisWorkbook.

[Darranimo]

I am trying to copy the sheets from every workbook located in a file to the workbook I have open as separate worksheets. I have tried the following code but it also makes copies of the sheets in the workbook that holds the code:

Sub CallData()
Dim wb As Workbook
Dim FilePath As String
Dim Filename As String
Dim Sheet As Worksheet
Application.ScreenUpdating = False

Set FileDialog = Application.FileDialog(msoFileDialogFolderPicker)
FileDialog.AllowMultiSelect = False
FileDialog.Title = "Select the Excel Files"
If FileDialog.Show <> -1 Then
    Exit Sub
End If

FilePath = FileDialog.SelectedItems(1) & "\"
Filename = Dir(FilePath & "*.xlsm*")

Do While Filename <> ""
    Set wb = Workbooks.Open(Filename:=FilePath & Filename)
    For Each Sheet In wb.Sheets
        If Sheet.Visible = xlSheetVisible Then 'only copy visible sheets
            Sheet.Copy After:=ThisWorkbook.Sheets(1)
        End If
    Next Sheet
    wb.Close
    'Filename = Dir()
Loop
End Sub

Each workbook that it is copying only contains one sheet. I would like these sheets to copied into the "master workbook" after the sheets that exist in the "master workbook". I would really appreciate the help in solving this issue for if it works it will save me a ton of time!

 

[AC PORTA VIA]

Try this

Sub CallData()
Dim wb2 As Workbook
Dim wb As Workbook
Dim FilePath As String
Dim Filename As String
Dim Sheet As Worksheet
Application.ScreenUpdating = False
Set wb2 = ActiveWorkbook
Set FileDialog = Application.FileDialog(msoFileDialogFolderPicker)
FileDialog.AllowMultiSelect = False
FileDialog.Title = "Select the Excel Files"
If FileDialog.Show <> -1 Then
    Exit Sub
End If

FilePath = FileDialog.SelectedItems(1) & "\"
Filename = Dir(FilePath & "*.xlsm*")

Do While Filename <> ""
    Set wb = Workbooks.Open(Filename:=FilePath & Filename)
    For Each Sheet In wb.Sheets
        If Sheet.Visible = xlSheetVisible Then 'only copy visible sheets
            Sheet.Copy After:=wb2.Sheets(1)
        End If
    Next Sheet
    wb.Close
    Filename = Dir()
Loop
End Sub

 

[Darranimo]

Try this

Sub CallData()
Dim wb2 As Workbook
Dim wb As Workbook
Dim FilePath As String
Dim Filename As String
Dim Sheet As Worksheet
Application.ScreenUpdating = False
Set wb2 = ActiveWorkbook
Set FileDialog = Application.FileDialog(msoFileDialogFolderPicker)
FileDialog.AllowMultiSelect = False
FileDialog.Title = "Select the Excel Files"
If FileDialog.Show <> -1 Then
    Exit Sub
End If

FilePath = FileDialog.SelectedItems(1) & "\"
Filename = Dir(FilePath & "*.xlsm*")

Do While Filename <> ""
    Set wb = Workbooks.Open(Filename:=FilePath & Filename)
    For Each Sheet In wb.Sheets
        If Sheet.Visible = xlSheetVisible Then 'only copy visible sheets
            Sheet.Copy After:=wb2.Sheets(1)
        End If
    Next Sheet
    wb.Close
    Filename = Dir()
Loop
End Sub

Thank you!!!! Works perfectly!!