Sub Test()
    Dim wb As Workbook, ws As Worksheet, sPath As String, fn As String
    Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        For Each ws In ThisWorkbook.Worksheets
            If ws.Name <> "Sheet1" Then ws.Delete
        Next ws
        Application.DisplayAlerts = True
        sPath = ThisWorkbook.Path & "\"
        fn = Dir(sPath & "*.xls*")
        Do While fn <> ""
            If fn <> ThisWorkbook.Name Then
                Set wb = Workbooks.Open(sPath & fn, , True)
                wb.Worksheets(1).Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
                ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = Replace(fn, ".xlsx", "")
                wb.Close False
            End If
            fn = Dir
        Loop
        Application.Goto ThisWorkbook.Sheets("Sheet1").Range("A1")
    Application.ScreenUpdating = True
End Sub