Sub GetSheets() 'Update ExcelJunction.com Path = "" Filename = Dir(Path & "*.xlsx") Do While Filename <> "" Workbooks.Open Filename:=Path & Filename, ReadOnly:=True For Each Workbook In Workbooks If Workbook.Name <> ThisWorkbook.Name Then Workbook.Worksheets(1).Copy Before:=ThisWorkbook.Sheets(1) ActiveSheet.Name = Workbook.Name End If Next Set Workbook = Nothing Workbooks(Filename).Close Filename = Dir() Loop End Sub --------------------------------------------------------------