Question

下午好，

下面的代码将名为“ CLS”的Excel工作表从多个Excel文件复制到一个新文档中，并将其命名为CM.xlsx的财务指标。不幸的是，它不会复制“ CLS”是工作表名称（我也需要包括在内）的一部分的任何工作表。我曾尝试在搜索时将DIM ws = worksheet添加为通配符的一部分，但无济于事。我是否应该尝试编写一个'If'字符串来产生所需的结果？我很茫然。

Sub CopyWS()
    Dim wbOpen As Workbook
    Dim wbNew As Workbook
    Const strPath As String = "C:\Users\Desktop\Financial Monthly Report\"
    Dim strExtension As String

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    On Error Resume Next
        ChDir strPath

        strExtension = Dir("*.xlsx")

        Set wbNew = Workbooks.Add
        wbNew.SaveAs Filename:="C:\Users\Desktop\Final\Financial Metrics for CLS", FileFormat:=xlWorkbookNormal

            Do While strExtension <> ""
                Set wbOpen = Workbooks.Open(strPath & strExtension)

                With wbOpen
                    .Sheets("CLS").Copy After:=wbNew.Sheets(wbNew.Sheets.Count)
                    wbNew.Sheets(wbNew.Sheets.Count).Name = wbNew.Sheets(wbNew.Sheets.Count).Cells(1, 1)
                    .Close SaveChanges:=False
                End With

                strExtension = Dir
            Loop

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    On Error GoTo 0
End Sub

Answer 1

在这种情况下，您可以循环浏览新打开的工作簿中的每个工作表，并检查名称是否包含字符串CLS。

   Do While strExtension <> ""

        Set wbOpen = Workbooks.Open(strPath & strExtension)

        Dim checkSheet as Worksheet
        For each checkSheet in wbOpen.Worksheets
            If UCase$(checkSheet.Name) Like "*CLS*" Then
                checkSheet.Copy After:=wbNew.Sheets(wbNew.Sheets.Count)
                wbNew.Sheets(wbNew.Sheets.Count).Name = wbNew.Sheets(wbNew.Sheets.Count).Cells(1, 1)
            End If
        Next

        wbOpen.Close SaveChanges:=False

        strExtension = Dir

    Loop

将具有特定名称的Excel工作表从多个工作簿复制到新工作簿

1 个答案: