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

希望能帮助其他人解决同样的问题！

Answer 2

您的副本行应

Workbooks("Original Workbook.xlsm").Sheets(Array("Sheet1", "Sheet2")).Copy _
 Before:=W.Sheets(1)

Answer 3

您可以使代码完全可变，而不是编码“Orginal Workbook.xlsm”以及Sheet1和Sheet2名称

如果您使用两个工作簿变量，则可以将 ActiveWorbook （即当前在Excel中选择的那个）设置为要复制的工作簿（或者您可以将其设置为已关闭的工作簿，现有的打开命名工作簿，或包含代码的工作簿）。

标准

Application.Workbooks.Add

您将获得一个新工作簿，其中包含根据您的默认选项安装的工作表数量（通常为3张）通过指定

 Application.Workbooks.Add(1)

只使用一张工作表创建一个新工作簿

请注意我通过将EnableEvents设置为False来禁用宏，但在创建工作簿时运行应用程序事件是不常见的

然后在复制表格时使用

 Sheets(Array(Wb1.Sheets(1).Name, Wb1.Sheets(2).Name)).Copy 
 'rather than
 Sheets(Array("Sheet1", "Sheet2")).Copy

避免硬编码要复制的工作表名称。此代码将复制两个leftmoast表而不管命名

最后删除了最初的单张纸，留下了一个新文件，里面只有两张复制的纸张

Sub NewReport()
    Dim Wb1 As Workbook
    Dim Wb2 As Workbook
    Dim dateStr As String
    Dim myDate As Date

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

    Set Wb1 = ActiveWorkbook

    myDate = Date

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

    Set Wb2 = Application.Workbooks.Add(1)
    Wb1.Sheets(Array(Wb1.Sheets(1).Name, Wb1.Sheets(2).Name)).Copy Before:=Wb2.Sheets(1)
    Wb2.Sheets(Wb2.Sheets.Count).Delete
    Wb2.SaveAs Filename:="c:\test\" & "New Report Name" & " " & dateStr, FileFormat:=51

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

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

3 个答案: