Macro to copy all worksheets into CSV files

[cidfidou]

Hi Excel Masters,

I am writing a new thread to make sure this is clear.

As i am useless in VBA, I am hoping that someone will write or copy an existing code to do the following :

- Save all worksheets of the current workbook into CSV files under the name of each worksheets
- the cherry on top of the cake would be a pop up window letting the user choose the location where to save the csv files (only once for all the worksheets)

As per usual, thanks in advance

 

[Pascal]

Hi,

Taking the previous solution from your earlier post, how about this?

Sub CreateWorkbooks()

Dim wbDest As Workbook
Dim wbSource As Workbook
Dim sht As Object
Dim strSavePath As String

On Error GoTo ErrorHandler

Application.ScreenUpdating = False

strSavePath = InputBox("Enter location to save files.", "File Destination", "C:\Temp\")

Set wbSource = ActiveWorkbook

For Each sht In wbSource.Sheets
sht.Copy
Set wbDest = ActiveWorkbook
wbDest.SaveAs strSavePath & sht.Name, xlCSV
wbDest.Close
Next

Application.ScreenUpdating = True

Exit Sub

ErrorHandler:
MsgBox "An error has occurred. Error number=" & Err.Number & ". Error description=" & Err.Description & "."
End Sub

Regards

 

[DeusXv]

Hi,

Taking the previous solution from your earlier post, how about this?

Sub CreateWorkbooks()

Dim wbDest As Workbook
Dim wbSource As Workbook
Dim sht As Object
Dim strSavePath As String

On Error GoTo ErrorHandler

Application.ScreenUpdating = False

strSavePath = InputBox("Enter location to save files.", "File Destination", "C:\Temp\")

Set wbSource = ActiveWorkbook

For Each sht In wbSource.Sheets
sht.Copy
Set wbDest = ActiveWorkbook
wbDest.SaveAs strSavePath & sht.Name, xlCSV
wbDest.Close
Next

Application.ScreenUpdating = True

Exit Sub

ErrorHandler:
MsgBox "An error has occurred. Error number=" & Err.Number & ". Error description=" & Err.Description & "."
End Sub

Regards

Don't know why I never though of an input box

 

[Pascal]

Hi,

The input box does the trick, although it's a little rough & ready as the user could enter a location that doesn't exist. Only way around that would be to add some validation on what is entered, or going to lengths of creating a form that would allow you to detail drives etc.

But hopefully this will provide cidfidou with what he wants?

Regards

 

[cidfidou]

Pascal,

that is awesome... Thank you!!!!

 

[Pascal]

No problem, you're welcome.

 

[DeusXv]

Hi,

The input box does the trick, although it's a little rough & ready as the user could enter a location that doesn't exist. Only way around that would be to add some validation on what is entered, or going to lengths of creating a form that would allow you to detail drives etc.

But hopefully this will provide cidfidou with what he wants?

Regards

Yeah would require some work if there was going to be some other users on it, but as stands it's a nice easy solution to the problem, better than any of the ideas I had anyway

 

[cytop]

As it can be incorporated easily, perhaps...

Sub x()

    Dim oFldr As FileDialog
    Dim strSavePath As String
    
    Set oFldr = Application.FileDialog(msoFileDialogFolderPicker)
    
    With oFldr

        .Title = "Select a directory"
        .AllowMultiSelect = False
        .InitialFileName = ActiveWorkbook.Path


        If .Show = True Then
            strSavePath = .SelectedItems(1)
        Else
            MsgBox "no folder selected...", vbExclamation
            Exit Sub
        End If
        
        MsgBox "Selected folder: " & strSavePath, vbInformation

    End With
    
End Sub

 

[cidfidou]

Hi Cytop,

sry for being demanding, but could you please show me how to incorporate your above code in the one delivered by pascal?

Thanks in advance

 

[Teeroy]

What about using Application.FileDialog to get a location?

e.g. (from VBA Excel Getting File Path (ends with folder) - Stack Overflow)

Sub SelectFolder()
    Dim diaFolder As FileDialog
    Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
    diaFolder.AllowMultiSelect = False
    diaFolder.Show

    MsgBox diaFolder.SelectedItems(1)

    Set diaFolder = Nothing
End Sub