Get the New Workbook When Copying a Worksheet

user_14518362 0
Viewed 75

I have several sheets I need to copy to a new workbook and then save this workbook.

I'm using the worksheet function to copy which it seems to me like it's the intended purpose of that function.

Here's the MSDN documentation on how to do this task:

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

This is doing exactly what I want, but it's using the ActiveWorkbook property which might cause some error, if running other codes or just working in parallel of this code running.

I'm looking for a way to manipulate the newly created workbook without having to use the ActiveWorkbook property.

Something along the lines of this:

Dim wb as Workbook

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

I've already tried this and it didn't work, but it's just to illustrate the point that it's not using the ActiveWorkbook property to refer to the new workbook.

Thanks in advance

vba excel
3 Answers

From above comment:

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 is right though - typically just using ActiveWorkbook is fine.

user_4788840

An improvement on @TimWilliams response so that you can copy multiple sheets at once:

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
user_84889130

Copy Worksheet(s) to a New Workbook

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
user_98140690
Related