Question

我正在尝试复制名为＆＃34; application＆＃34;的工作表。从文件夹中的所有相同文件，到主工作簿，并将复制的工作表重命名为从中复制的文件的名称。到目前为止，我的代码复制了所有内容，我无法将复制的工作表重命名为它来自的文件名。

谢谢

 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 条件正在关闭，然后才会复制应用程序＆＃39;工作表，因此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

我无法使用路径作为变量（可能是由于某些系统配置 - 需要检查原因），所以我使用了 Path1 。您也可以使用ActiveWorkbook.Sheets代替Workbooks(Filename).Sheets。但是我觉得以其名称引用工作簿会更好。

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

1 个答案: