创建新的工作簿并通过

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

你可以让你的代码完全可变的，而不是harcoding“原单Workbook.xlsm”和工作表Sheet1和sheet2名称

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

使用标准

Application.Workbooks.Add 

你会得到安装，按您的默认选项（normnally 3张） 张数的新的工作簿通过指定

Application.Workbooks.Add(1) 

一个新的工作簿只用一张纸创建

并注意我通过将EnableEvents设置为False来禁用宏，但是将应用程序e创建工作簿

时然后复制片使用

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