复制工作表时获取新工作簿

Question

我有几张纸需要复制到新工作簿，然后保存此工作簿。

我正在使用工作表功能进行复制，在我看来这是该功能的预期目的。

这是关于如何执行此任务的 MSDN 文档：

Worksheets("Sheet1").Copy
With ActiveWorkbook 
     .SaveAs Filename:=Environ("TEMP") & "\New1.xlsx", FileFormat:=xlOpenXMLWorkbook
     .Close SaveChanges:=False
End With

https://docs.microsoft.com/en-us/office/vba/api/excel.worksheet.copy

这正是我想要的，但它使用的是 ActiveWorkbook 属性，如果运行其他代码或只是与此代码并行工作，这可能会导致一些错误运行 .

我正在寻找一种无需使用 ActiveWorkbook 即可操作新创建的工作簿的方法属性。

大致如下：

Dim wb as Workbook

set wb = Worksheets("Sheet1").Copy
wb.SaveAs Filename:=Environ("TEMP") & "\New1.xlsx", FileFormat:=xlOpenXMLWorkbook
wb.Close SaveChanges:=False

我已经试过了，但没有用，但这只是为了说明它没有使用 ActiveWorkbook 属性来引用新工作簿这一点。

提前致谢

Answer 1

来自以上评论：

Sub Tester()
    With AsNewWorkbook(Sheet1)
        Debug.Print .Name
        .SaveAs "C:\Temp\blah.xlsx"
    End With
End Sub

Function AsNewWorkbook(ws As Worksheet)
    Dim wb As Workbook
    Set wb = Workbooks.Add(xlWBATWorksheet) 'has one sheet...
    With wb.Sheets(1) 'stolen from Cristian's answer...
        If .Name = ws.Name Then .Name = .Name & "x"
    End With
    ws.Copy before:=wb.Worksheets(1)
    Application.DisplayAlerts = False
    wb.Worksheets(2).Delete
    Application.DisplayAlerts = True
    Set AsNewWorkbook = wb
End Function

@BigBen 是对的——通常只使用 ActiveWorkbook 就可以了。

Answer 2

对@TimWilliams 响应的改进，以便您可以一次复制多张纸：

Sub Test()
    Dim sourceBook As Workbook
    '
    Set sourceBook = ThisWorkbook 'Or ActiveWorkbook or whatever book is needed
    With CopySheetsToNewBook(sourceBook.Sheets(Array("Sheet1", "Sheet2")))
        .SaveAs Filename:=Environ("TEMP") & "\New1.xlsx", FileFormat:=xlOpenXMLWorkbook
    End With
    sourceBook.Close SaveChanges:=False
End Sub


Public Function CopySheetsToNewBook(ByVal theSheets As Sheets) As Workbook
    If theSheets Is Nothing Then
        Err.Raise 91, "CopySheetsToNewBook", "Sheets not set"
    End If
    '
    Dim newBook As Workbook
    Dim tempSheet As Worksheet
    '
    Set newBook = Application.Workbooks.Add(xlWBATWorksheet)
    Set tempSheet = newBook.Worksheets(1) 'To be deleted later
    tempSheet.Name = CDbl(Now) 'Avoid name clashes with the sheets to be copied
    '
    theSheets.Copy Before:=tempSheet
    Application.DisplayAlerts = False
    tempSheet.Delete
    Application.DisplayAlerts = True
    '
    Set CopySheetsToNewBook = newBook
End Function

Answer 3

将工作表复制到新工作簿

Sub NewWorkbook()
    
    ' Reference the source workbook.
    Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code
    
    swb.Worksheets("Sheet1").Copy ' copy one worksheet to a new workbook
    'swb.Worksheets(Array("Sheet1", "Sheet2")).Copy ' copy multiple worksheets
    
    ' Reference the destination (new) workbook.
    Dim dwb As Workbook: Set dwb = Workbooks(Workbooks.Count)
    
    Debug.Print swb.Name, dwb.Name

End Sub

复制工作表时获取新工作簿

Get the New Workbook When Copying a Worksheet

excel

vba

将工作表复制到新工作簿