VBA to copy worksheet into new workbook and then save, close and return to original

Hi,
I am looking at a macro that copies one worksheet (values and formats) from Workbook A into a new workbook (Workbook B). The sheet in question contains a cell (FO9) that I would like the new file name to be called.
I currently have the copy and paste function working ok, and all data has copied over correctly to the new workbook.  

What I’m after is for the new workbook to “save as” automatically as an XLSM file using the name in cell FO9 in workbook B. The user must however be asked where to save it (save as). I then need this workbook to close and for the user to return back to cell AO64 in Workbook A, with Sheet 1 being hidden again, and for Sheet 2 to then become the active worksheet again.

The code I currently have is: 

Sub SaveAsA0()
Application.ScreenUpdating = False
Range("D3").Select
Sheets("Sheet 1").Visible = True
Sheets("Sheet 2").Visible = True
Sheets("Sheet 1").Select

ActiveSheet.Copy
    With ActiveSheet.UsedRange
         .Copy
         .PasteSpecial xlValues
         .PasteSpecial xlFormats
         End With
    Application.CutCopyMode = False
    
    
End Sub

Open in new window

Dan FullerAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

NorieAnalyst Assistant Commented:
Try this, I think it covers all the requirements you set out.
Sub SaveAsA0()
Dim wbA As Workbook
Dim wbB As Workbook
Dim strFileName As String

    Application.ScreenUpdating = False

    Set wbA = ThisWorkbook

    wbA.Sheets("Sheet1").Visible = True
    
    wbA.Sheets("Sheet1").Copy

    Set wbB = ActiveWorkbook

    With wbB
    
        With .Sheets(1).UsedRange
            .Copy
            .PasteSpecial xlValues
            .PasteSpecial xlFormats
        End With
        Application.CutCopyMode = False
        strFileName = .Sheets(1).Range("FO9").Value

        .SaveAs wbB.Path & Application.PathSeparator & strFileName & ".xlsm", xlOpenXMLWorkbookMacroEnabled
        .Close SaveChanges:=False
    End With

    wbA.Sheets("Sheet1").Visible = False
    
    Application.Goto wbA.Sheets("Sheet2").Range("AO64")
    
End Sub

Open in new window

Dan FullerAuthor Commented:
Hi Nori,

Thanks for the info.

Unfortunately that gives me a debug error 1004 - saying Microsoft Excel cannot access the file C:\C3E9D080.

When I click on debug it highlights this bit of code: 

.SaveAs wbB.Path & Application.PathSeparator & strFileName & ".xlsm", xlOpenXMLWorkbookMacroEnabled

Open in new window

NorieAnalyst Assistant Commented:
Dan

Where do you want to save the new workbook?

Also, what is the value in FO9 on the worksheet being copied?
Angular Fundamentals

Learn the fundamentals of Angular 2, a JavaScript framework for developing dynamic single page applications.

Enroll Today!
Dan FullerAuthor Commented:
Hi Norie,


The save location would ideally be chosen by the user (but worst case scenario to the same location as the original file).

The value in FO9 is a concatenate of other cells, made up from first name, surname and dob. It is as followsL

Surname, First Name mm-dd-yyyy (Email Version)
NorieAnalyst Assistant Commented:
Dan

Oops, I made a bit of a typo - wbB,Path should be wbA.Path, try this.
      .SaveAs wbA.Path & Application.PathSeparator & strFileName & ".xlsm", xlOpenXMLWorkbookMacroEnabled

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Dan FullerAuthor Commented:
That's perfect thank you for your help!
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.