VBA将特定工作表复制到现有书籍

这里的任务是双重的（第一部分已经工作了）。
任务1：将从combobox中select的工作表复制到新文档中。
任务2：从原始文档复制特定工作表并将其添加到上面创build的新文档中。

到目前为止，我已经得到了这个:(但第二个任务不起作用）

Sub Extract() Dim wbkOriginal As Workbook Set wbkOriginal = ActiveWorkbook 'sets site and engineer details into the estate page that is being extracted Worksheets(FrontPage.CmbSheet.Value).Range("B3").Value = Worksheets("front page").Range("E6") Worksheets(FrontPage.CmbSheet.Value).Range("D3").Value = Worksheets("front page").Range("N6") Worksheets(FrontPage.CmbSheet.Value).Range("F3").Value = Worksheets("front page").Range("K6") Worksheets(FrontPage.CmbSheet.Value).Range("B4").Value = Worksheets("front page").Range("F8") Worksheets(FrontPage.CmbSheet.Value).Range("D4").Value = Worksheets("front page").Range("K8") ' copies sheet name from combo box into new document, saves it with site name and current date ' into C:\Temp\ folder for ease of access With ActiveWorkbook.Sheets(FrontPage.CmbSheet.Value) .Copy ActiveWorkbook.SaveAs _ "C:\temp\" _ & .Cells(3, 2).Text _ & " " _ & Format(Now(), "DD-MM-YY") _ & ".xlsm", _ xlOpenXMLWorkbookMacroEnabled, , , , False End With Dim wbkExtracted As Workbook Set wbkExtracted = ActiveWorkbook Workbooks(wbkOriginal.Name).Sheets(DOCUMENTS).Copy _ After:=Workbooks(wbkExtracted.Name).Sheets(wbkExtracted.Name).Sheets.Count 'code to close the original workbook to prevent accidental changes etc 'Application.DisplayAlerts = False 'wbkOriginal.Close 'Application.DisplayAlerts = True End Sub 

我希望你们中的一个聪明的人可以告诉我我做错了什么:)

Answer 1

我想我知道你遇到的问题。 （也许）如果你正在使用一个新的Excel实例，你需要保存它，然后重新打开它。 它必须与对象模型有关。 我不得不在不久之前这样做。 这是我使用的代码片段。

 Set appXL = New Excel.application appXL.Workbooks.Add Set wbThat = appXL.ActiveWorkbook wbThat.application.DisplayAlerts = False wbThat.SaveAs Filename:=strFilePath & "\" & strFileName 'This code needed to allow the copy function to work wbThat.Close savechanges:=True Set wbThat = Nothing Set wbThat = application.Workbooks.Open(strFilePath & "\" & strFileName) appXL.Quit Set appXL = Nothing 'Copy Help page from this workbook to the report wbThis.Sheets("Help").Copy after:=wbThat.Sheets(wbThat.Sheets.Count) 

Answer 2

 Sub Full_Extract() Dim wbkOriginal As Workbook Set wbkOriginal = ActiveWorkbook 'sets site and engineer details into the estate page that is being extracted Worksheets(Sheet1.CmbSheet.Value).Range("B3").Value = Worksheets("front page").Range("E6") Worksheets(Sheet1.CmbSheet.Value).Range("D3").Value = Worksheets("front page").Range("N6") Worksheets(Sheet1.CmbSheet.Value).Range("F3").Value = Worksheets("front page").Range("K6") Worksheets(Sheet1.CmbSheet.Value).Range("B4").Value = Worksheets("front page").Range("F8") Worksheets(Sheet1.CmbSheet.Value).Range("D4").Value = Worksheets("front page").Range("K8") ' copies sheet name from combo box into new document, saves it with site name and current date ' into C:\Temp\ folder for ease of access With ActiveWorkbook.Sheets(Array((Sheet1.CmbSheet.Value), "Z-MISC")) .Copy ActiveWorkbook.SaveAs _ "C:\temp\" _ & ActiveWorkbook.Sheets(Sheet1.CmbSheet.Value).Cells(3, 2).Text _ & " " _ & Format(Now(), "DD-MM-YY") _ & ".xlsm", _ xlOpenXMLWorkbookMacroEnabled, , , , False End With 'code to close the original workbook to prevent accidental changes etc Application.DisplayAlerts = False wbkOriginal.Close Application.DisplayAlerts = True End Sub