Excel Forum

Code: Select all

Sub GetSheets()
' Collect Sheets by browse folder directory
Dim Get_Path As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    With Application.FileDialog(msoFileDialogFilePicker)
     Clicked = .Show
        If Clicked = 0 Then 'The Cancel button or the X is clicked.
            Exit Sub
        ElseIf Clicked <> 0 Then ' if OK is pressed
            Get_Path = .SelectedItems(1) & "\"
        End If
Path = Get_File
End With
Filename = Dir(Path & "*.xlsx")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Code: Select all

Sub GetSheets()
    ' Collect Sheets by browse folder directory
    Dim Get_Path As String
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    '    With Application.FileDialog(msoFileDialogFilePicker)
    '     Clicked = .Show
    '        If Clicked = 0 Then 'The Cancel button or the X is clicked.
    '            Exit Sub
    '        ElseIf Clicked <> 0 Then ' if OK is pressed
    '            Get_Path = .SelectedItems(1) & "\"
    '        End If
    'Path = Get_File
    'End With
    'Filename = Dir(Path & "*.xlsx")
    'Do While Filename <> ""
    Get_Path = Application.GetOpenFilename("Excel file(*.xls*),*.xls*")
    If Get_Path = "False" Then Exit Sub
    Workbooks.Open Filename:=Get_Path, ReadOnly:=True
    For Each Sheet In ActiveWorkbook.Sheets
        Sheet.Copy After:=ThisWorkbook.Sheets(1)
    Next Sheet
    Workbooks(VBA.Split(Get_Path, "\")(UBound(VBA.Split(Get_Path, "\")))).Close
    'Filename = Dir()
    'Loop
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub