Question

这里的任务是双重的（虽然第一部分已经有效）任务1：将从组合框中选择的工作表复制到新文档中任务2：从原始文档复制特定工作表并将其添加到上面创建的新文档中。

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

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

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

2 个答案: