Sub GetSheets() 'Updated by Extendoffice 2019/2/20 Path = "C:\Users\ASUS\Desktop\New folder\New folder\" 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 End Sub