VBA to copy worksheet to new workbook and save

kidwispa

Active Member
Joined
Mar 7, 2011
Messages
330
Hi All,

I asked a similar question on this thread but have managed to get most of the problem solved. The only bit I am struggling with now is how to copy the entire worksheet into a new workbook and save the file to a specific directory with the following filename format ("exceptions191011 - ie. the word exceptions followed by today's date in ddmmyy format).

Here is what I've got so far:

Code:
Sub SaveAs()
 
    Dim FName           As String
    Dim FPath           As String
 
    FPath = "G:\Exceptions\"
    FName = "Exceptions" & Format(Date, "ddmmyy") & ".xls"
 
    Sheets("DataSort").Copy
    ThisWorkbook.Sheets("Sheet1").SaveAs Filename:=FPath & "\" & FName
 
End Sub

Thanks in advance for any suggestions

EDIT - This now seems to work - could someone please help me add the following condition that if a file already exists with that name then to bring up an error message stating the file already exists?

2ND EDIT - As well as save the new workbook, it appears to close the original workbook - can I stop this?



:)
 
Last edited:

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
If you use ThisWorkbook then you are saving the workbook with the code in it rather than the new one you've created. This will be with the new name (Exceptions etc). That's why the it appears that the original workbook is being closed. The following code should do all you want.

Code:
Sub SaveAs()
 
    Dim FName           As String
    Dim FPath           As String
    Dim NewBook         As Workbook
 
    FPath = "G:\Exceptions"
    FName = "Exceptions" & Format(Date, "ddmmyy") & ".xls"
 
    Set NewBook = Workbooks.Add
 
    ThisWorkbook.Sheets("DataSort").Copy Before:=NewBook.Sheets(1)
 
    If Dir(FPath & "\" & FName) <> "" Then
        MsgBox "File " & FPath & "\" & FName & " already exists"
    Else
        NewBook.SaveAs Filename:=FPath & "\" & FName
    End If
 
End Sub
 
Upvote 0
Hi gsbelbin,

Thanks for this. I was running this bit of code originally:

Sheets(1).Copy
Set Wb = ActiveWorkbook
Wb.SaveAs . . .

Running this in xl2003 on some very old (slow) machines, occasionally Wb would get set to ThisWorkbook, and that's what would get saved, instead of the newly created workbook. Appeared to be a bit of a "race" going on, with Wb getting set before the new workbook appeared on screen. With your code, I'm now able to ensure that Wb is set correctly. Thank you.

Regards,

Dave
 
Last edited:
Upvote 0
If you use ThisWorkbook then you are saving the workbook with the code in it rather than the new one you've created. This will be with the new name (Exceptions etc). That's why the it appears that the original workbook is being closed. The following code should do all you want.

Code:
Sub SaveAs()
 
    Dim FName           As String
    Dim FPath           As String
    Dim NewBook         As Workbook
 
    FPath = "G:\Exceptions"
    FName = "Exceptions" & Format(Date, "ddmmyy") & ".xls"
 
    Set NewBook = Workbooks.Add
 
    ThisWorkbook.Sheets("DataSort").Copy Before:=NewBook.Sheets(1)
 
    If Dir(FPath & "\" & FName) <> "" Then
        MsgBox "File " & FPath & "\" & FName & " already exists"
    Else
        NewBook.SaveAs Filename:=FPath & "\" & FName
    End If
 
End Sub


This code has been very helpful for me as I was doing something very similar. I am trying to copy several worksheets from the same workbook into a new book. I thought I could just change the line of code that is

ThisWorkbook.Sheets("DataSort").Copy but that didn't work.

When I change the name and use just one worksheet reference I can copy one worksheet. Can someoen help me out with the code to copy multiples. Also what I really need to do is I have a many worksheets and each of them have a responsible persons name in cell I16. I want to actually input a formula to find all worksheets with that persons name and create a new workbook will all the worksheets they are responsible for. If I can't do that then I would just like to be able to input the worksheet names to call them out. Below is an example of the code I tried that didn't work.

ThisWorkbook.Sheets("67.5111", "67.5112", "67.5121").Copy Before:= NewBook.Sheets(1)
 
Upvote 0

Forum statistics

Threads
1,213,510
Messages
6,114,034
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top