創建新的工作簿並通過

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