Save Active Sheet to another Workbook

[Wes28]

Hi guys.

Was curious if there is a way one could. Copy the active sheet that is open in a work book and save it to another file with the date in the name?

For example Report_11-03-08.xls

The only problem I see with this. How could I also make it append a letter to report if the file already exits

Example saved as
Report1_11-03-08.xls

Then just continue incrementing.

Below is all I've come up with so far.

Thanks

Sub CopySave()

Application.ScreenUpdating = False

ActiveSheet.Copy

Application.DisplayAlerts = False

ActiveSheet.SaveAs Filename:=ThisWorkbook.Path & "/" & "Report_" & Format(Date, "mm_dd_yy") & ".xls"


ActiveWorkbook.Close

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

[protonLeah]

Try this mod:

Please Login or Register  to view this content.

[Wes28]

protonLeah,

Thankyou so much worked very well. One question though. Still a little rough for the noob here. Is there a way to keep it indexing if someone saves the file more then twice?

They may save the file sometimes twice a day. At other times more then 25 times a day.

Thanks again.

[royUK]

Use the hour of saving as well

Please Login or Register  to view this content.

[Wes28]

royUK,

Thanks for your idea. Forgot about the Hour format. Running into a problem with it. Its saving the file as "Report_11_04_08_00.xls". When I step through it again it just over rights the same file. Do you see anything wrong with what I did?

Thanks Again.

Sub CopySave()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim fn As String

fn = ThisWorkbook.Path & "\" & "Report_" & Format(Date, "mm_dd_yy_hh") & ".xls"


ActiveSheet.Copy
ActiveSheet.SaveAs Filename:=fn
ActiveWorkbook.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

[Wes28]

Thanks for all the Help I solved the problem.

Sub CopySave()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim fn As String

'copies form to the same directory
fn = ThisWorkbook.Path & "\" & "Report " & Format(Now, "mm-dd-yy hhmm") & ".xls"


ActiveSheet.Copy
ActiveSheet.SaveAs Filename:=fn
ActiveWorkbook.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub