tags:

views:

482

answers:

2

Below is a macro to save multiple sheets to different csv files BUT it keeps renaming and saving the original workbook, how to stop this.

Private Sub CommandButton1_Click()

Dim WS As Excel.Worksheet
Dim SaveToDirectory As String

Dim CurrentWorkbook As String
Dim CurrentFormat As Long
Dim myName As String
myName = myName & Application.Cells(2, 2) 'cell B2 '

CurrentWorkbook = ThisWorkbook.FullName

CurrentFormat = ThisWorkbook.FileFormat

' Store current details for the workbook '

SaveToDirectory = "C:\temp\"

' This line to correct problem with slash in Stackoverflow code formatting

For Each WS In ThisWorkbook.Worksheets
  WS.SaveAs SaveToDirectory & myName & WS.Name, xlCSV
Next

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = False
' Temporarily turn alerts off to prevent the user being prompted '
'  about overwriting the original file. '

End Sub
+2  A: 

ActiveWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat Application.DisplayAlerts = False

If you are not writing anything on the workbook, why are you trying to save it?

shahkalpesh
The purpose was to save each individual worksheet to a separate csv file from the workbook. Thank you.
A: 

Try this:

Private Sub CommandButton1_Click()

    Dim WS As Excel.Worksheet
    Dim SaveToDirectory As String
    Dim myName As String
    Dim CurrentWorkbook As String

    ' Get the path to the curent workbook so we can open it later.
    CurrentWorkbook = ThisWorkbook.FullName

    SaveToDirectory = "C:\temp\"

    ' Turn off Excel alerts so we're not prompted if the file already exists.
    Application.DisplayAlerts = False

    For Each WS In ThisWorkbook.Worksheets
        WS.Activate                      ' Make this the current worksheet.
        myName = Application.Cells(2, 2) ' Get the contents of cell B2 for our file name.
        WS.SaveAs SaveToDirectory & myName & WS.Name, xlCSV
    Next

    ' Open the original workbook.
    Application.Workbooks.Open CurrentWorkbook

    ' Close workbook associated with the last saved worksheet.
    ThisWorkbook.Close xlDoNotSaveChanges

End Sub

It looks like the Excel SaveAs method makes the saved worksheet the active workbook, so I just close this without saving.

Patrick Cuff
Hi Patrick. I copied your macro and I seem to get run time error 1004, method "SaveAs" of object '_worksheet' failed. Can please assist.
That's weird; there's very little difference between your code and my code. Make sure you pasted this correctly. Also, change the SaveToDirectory to "C:\temp\".
Patrick Cuff
Happy New Year to all. May the New Year bring health and wealth to all.Hi Patrick. Have pasted the whole code and keep getting the same error message. I have also change the directory to c:\temp. Is this common problem with Excel 2003 with SP3?. Thanking you in advance.
John, I can't recreate your issue; the code I have works fine. What's your macro level security? Try lowering it and see if that helps. Also check that the user running the macro has write access to C:\temp. Also, try replacing 'xlCSV' with '6' in the call to SaveAs.
Patrick Cuff
OK, I was just able to recreate the issue by changing the SaveToDirectory var to a path that doesn't exist (D:\temp for me). I think you are either saving to an invalid path, or a path you don't have write access for.
Patrick Cuff