excel - 创建新工作簿并复制工作表

Question

所讨论的问题集中在一本工作簿上，其中包含我的所有数据和分布在大量工作表中的故障。我正在尝试设置宏以将选定的工作表复制到新的工作簿。我认为我最大的问题是为目标工作簿进行正确的编码，因为名称包含每天都会更改的日期字符串。到目前为止，我创建新工作簿并关闭它的代码是:

Sub NewReport()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    MyDate = Date

    Dim dateStr As String
    dateStr = Format(MyDate, "MM-DD-YY")

    Set W = Application.Workbooks.Add

    W.SaveAs Filename:="N:\PAR\" & "New Report Name" & " " & dateStr, FileFormat:=51

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    ActiveWorkbook.Close True
End Sub

这可以工作并完成我想要的创建新文档、按照应有的命名方式命名以及最后关闭它的操作。我需要帮助的是中间部分，用于将特定工作表从原始工作簿复制到新工作簿。我的想法是这样的:

 With Workbooks("Original Workbook.xlsm")
            .Sheets(Array("Sheet1", "Sheet2")).Copy_ Before:=Workbooks("destination.xls").Sheet1

或者至少某种类型的数组来准确获取我想要复制的内容。最大的症结在于正确获取目标工作簿路径名称。对于这个小项目的各个部分或整体的任何建议，我们将不胜感激。谢谢!

编辑:我还需要指出，生成的新工作簿必须是普通的旧 Excel 格式 (.xlsx)。没有宏，没有自动更新链接或启用宏、zip 的安全警告。只是一本普通的书，里面有我告诉它放在那里的床单。

Answer 1

好的。我现在终于开始工作了。工作表名称被保留(否则我将不得不重新命名它们)；它保存一份要发送的副本和一份到我们的存档文件夹中的副本；并且新工作簿不会出现任何有关启用宏或更新链接的弹出窗口。我最终确定的代码(可能可以稍微修改一下)是:

Sub Report()

    Dim Wb1 As Workbook
    Dim dateStr As String
    Dim myDate As Date
    Dim Links As Variant
    Dim i As Integer

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
    End With

    Set Wb1 = ActiveWorkbook

    myDate = Date

    dateStr = Format(myDate, "MM-DD-YYYY")

    Wb1.Sheets(Array("Sheet1Name", "Sheet2Name", "etc."))Copy

    With ActiveWorkbook
    Links = .LinkSources(xlExcelLinks)
    If Not IsEmpty(Links) Then
        For i = 1 To UBound(Links)
            .BreakLink Links(i), xlLinkTypeExcelLinks
        Next i
    End If

    End With

    ActiveWorkbook.SaveAs Filename:="N:\" & "Report Name" & " " & dateStr, FileFormat:=51
    ActiveWorkbook.SaveAs Filename:="N:\Report Archive\" & "Report Name" & " " & dateStr, FileFormat:=51

    ActiveWorkbook.Close

    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
End Sub

希望这能帮助其他遇到同样问题的人!