将合并特定的工作表复制到一个工作簿

Question

I am trying to copy a worksheet called "application" from all identical files in a folder, into a master workbook and rename the copied worksheet in the name of the file its been copied from. So far my code copies everything and I cannot get it to rename the copied worksheet to name of file it came from.

Thank you

 Sub GetSheets()
     Application.ScreenUpdating = False
     Path = "C:\Users\Desktop\Work docs\"
     Filename = Dir(Path & "*.xls")
     Do While Filename <> ""
         Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
         For Each Sheet In ActiveWorkbook.Sheets
             If Sheet.Name = "application" Then
             End If
             Sheets.Copy After:=ThisWorkbook.Sheets(1)
         Next Sheet
         Workbooks(Filename).Close SaveChanges:=False
         Filename = Dir()
     Loop
     Application.ScreenUpdating = True
 End Sub

Answer 1

Your IF condition is closing before you are copying 'application' sheet, so Sheets.Copy will just copy all the sheets from your workbook. You can try the below code:

Do While Filename <> ""
    Workbooks.Open Filename:=Path1 & Filename, ReadOnly:=True
    For Each Sheet In Workbooks(Filename).Sheets
        If Sheet.Name = "application" Then
            Sheet.Copy After:=ThisWorkbook.Sheets(1)
            ThisWorkbook.Sheets("application").Name = Filename & "-application"    'Changes the sheetname from "application" of test1.xls workbook to "test1.xls-application"
        End If
    Next Sheet
    Workbooks(Filename).Close SaveChanges:=False
    Filename = Dir()
Loop

I was not able to use Path as a variable (maybe due to some system configuration - need to check why), so I have used Path1 instead. You can use ActiveWorkbook.Sheets also instead of Workbooks(Filename).Sheets . However I feel its better to reference a workbook by its name.