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

我试图从一个文件夹中所有相同的文件复制一个名为“应用程序”的工作表到一个主工作簿中，并将复制的工作表重命名为复制的文件的名称。 到目前为止，我的代码复制一切，我无法得到它重命名复制的工作表到它来自的文件的名称。

谢谢

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

您的IF条件在您复制“应用程序”表之前closures，因此Sheets.Copy将只复制工作簿中的所有表单。 你可以试试下面的代码：

 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 

我无法使用Path作为variables（可能是由于某些系统configuration – 需要检查原因），所以我使用了Path1 。 您也可以使用ActiveWorkbook.Sheets而不是Workbooks(Filename).Sheets 。 不过，我觉得最好是用名字来引用一个工作簿。