Question

我有多个工作簿，都有名为“example”的选项卡。我想调整当前文件以检查当前工作表是否命名为“example”，在“example”前面添加工作簿的名称，例如“File1示例”并将此选项卡移动到另一个文件中。

目前我有以下内容，它将所有工作簿中的所有选项卡拉入新工作簿。

Sub GetSheets()
Path = "C:\TestPath\"
Filename = Dir(Path & "*.xls")

MsgBox (Filename)

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

Answer 1

如果你已经知道它的名字，你可以直接访问它，而不是遍历工作簿的所有工作表。

另外，请确保不要超过工作表名称允许的最大长度。这是31个字符，因此修剪工作簿名称或者您可能会遇到错误。

Public Sub GetSheets()
    Dim Path As String
    Path = "C:\TestPath\"

    Dim Filename As String
    Filename = Dir(Path & "*.xls")

    Dim ws As Worksheet

    MsgBox (Filename)

    Dim OpenWb As Workbook
    Do While Filename <> ""
        Set OpenWb = Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True)
        OpenWb.Worksheets("example").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 'copy after last sheet
        ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Left$(OpenWb.Name, 31) 'don't exceed max allowed length

        OpenWb.Close False 'we do not save changes in the opened Workbook
        Filename = Dir()
    Loop
End Sub

请注意，如果任何文件可能没有名为example的工作表，则可能需要进行错误处理。

Answer 2

这样的事情对你有用。

Sub GetSheets()

Path = "C:\TestPath\"
Filename = Dir(Path & "*.xls")

Dim ws As Worksheet

MsgBox (Filename)


Do While Filename <> ""
    Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
    For Each ws In ActiveWorkbook.Sheets
        If ws.Name = "example" Then 'name of tab
            ws.Name = ws.Name & " " & ActiveWorkbook.Name
            ws.Copy After:=ThisWorkbook.Sheets(1)
            Exit For
        End If
    Next ws
    Workbooks(Filename).Close False 'we do not save changes in the opened Workbook
    Filename = Dir()
Loop
End sub

将特定选项卡从多个工作簿移动到单个工作簿中

2 个答案: