VBA to copy worksheet to new workbook and save

[kidwispa]

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:

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?

 

[gsbelbin]

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.

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

 

[kidwispa]

Thanks - will give it a try

 

[DaveU]

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

 

[dangexcel]

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.

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)