Creating a second workbook from an original workbook

Workbook has 10 tabs. With the use of a macro a new workbook is created with 5 of the tabs.
The new workbook is saved to where the original is with a new name - if that is possible.
Any help greatly appreciated.
dgd1212Asked:
Who is Participating?

Improve company productivity with a Business Account.Sign Up

x
 
redmondbConnect With a Mentor Commented:
Hi, dgd1212.

Please see attached. I've made a few changes...
 - Now saves as xlsm.
 - Corrected the check for an existing file.
 - Displays a message with the name of the file just saved.

The code is...
Option Explicit

Sub Copy_Sheets()
Dim xBook As Workbook
Dim xFileName As String

Application.ScreenUpdating = False
    Sheets(Array("Sheet10", "Sheet8", "Sheet6", "Sheet4", "Sheet2")).Copy
    Set xBook = ActiveWorkbook

    If Dir(ThisWorkbook.Path & "\" & "Fred.xlsm") <> "" Then
        xFileName = ThisWorkbook.Path & "\" & ThisWorkbook.Name & "_" & Format(Now(), "yyyymmdd_hhnnss") & ".xlsm"
        xBook.SaveAs Filename:=xFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    Else
        xFileName = ThisWorkbook.Path & "\" & "Fred.xlsm"
        xBook.SaveAs Filename:=xFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    End If

    xBook.Close savechanges:=False

Application.ScreenUpdating = True

MsgBox ("Sheets saved to " & xFileName)

End Sub

Open in new window

Regards,
Brian.Copy-Sheets-V2.xlsm
0
 
redmondbCommented:
Hi, dgd1212.

What version of Excel are you using?
What file type do you want to use (xlsx/xlsm/xlsb/xls)?
Any particular name for the new file?

Thanks,
Brian.
0
 
redmondbCommented:
dgd1212,

Please see previous post. I've made some assumptions...
 - The new file is saved as an xlsx.
 - Sheets2/4/6/8/10 are copied.
 - The output file is called "Fred.xlsx", unless that already exists, when the file is given the same name as the source file + "_yyyymmdd_hhmmss"

The code is...
Option Explicit

Sub Copy_Sheets()
Dim xBook As Workbook

Application.ScreenUpdating = False
    Sheets(Array("Sheet10", "Sheet8", "Sheet6", "Sheet4", "Sheet2")).Copy
    Set xBook = ActiveWorkbook

    If Dir(ThisWorkbook.Path & "\" & "Fred.xlsx") = "" Then
        xBook.SaveAs Filename:=ThisWorkbook.Path & "\" & ThisWorkbook.Name & "_" & Format(Now(), "yyyymmdd_hhnnss") & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Else
        xBook.SaveAs Filename:=ThisWorkbook.Path & "\" & "Fred.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    End If
    
    xBook.Close savechanges:=False

Application.ScreenUpdating = True

End Sub

Open in new window

Regards,
Brian.
Copy-Sheets.xlsm
0
Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
dgd1212Author Commented:
Brian,
I'm using Excel 2010. Type file would be xlsm (for macros?)
I used your attached example spreadsheet. Could not find the created file though. No fred.xlsx.
suggestions?
0
 
dgd1212Author Commented:
Brian,
Thank you!
0
 
redmondbCommented:
Glad to help, dgd1212!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.