save a single sheet filedialogbox

[Divan]

Hi all I am having a problem I am creating a csv from a single sheet in excel but i only want to save the sheet and not the whole workbook with a savefiledialog box at the moment the path is hard coded but I want the user to be able to select the destination where he wants to save the csv copy of the selected sheet and not the entire workbook

here is my code so far


Sub createcsv()
'
' createcsv Macro
' creates a csv from xl
'
Dim fs As Object, a As Object, i As Integer, s As String, t As String, l As String, mn As String, filename As String



Set fs = CreateObject("Scripting.FileSystemObject")
Destfile = "C:\Tum"

If Len(Dir(Destfile, vbDirectory)) = 0 Then ' CHECK IF PATH there

MkDir (Destfile) ' If NOT - Make IT
End If ' End Check Folder Name
If Len(Dir(Destfile, vbDirectory)) = 0 Then ' CHECK IF PATH there
Kill Destfile
MkDir (Destfile) ' If NOT - Make IT
End If ' End Check Folder Name

Set a = fs.CreateTextFile("c:\TUM\tum.csv", True) 'filesavedailog box


For r = 1 To Range("A65536").End(xlUp).Row
s = ""
c = 1

While Not IsEmpty(Cells(r, c))
s = s & Cells(r, c) & ","
c = c + 1
Wend
a.writeline s 'write line
Next r
MsgBox "The job is done !", vbInformation

End Sub

[Gopika Suraj]

Sub Test1()
Dim i As Integer
Dim ws As Worksheet
Dim CntSheets As Long
Application.DisplayAlerts = False
CntSheets = Worksheets.Count
ct = CntSheets
While ct > 1
Sheets("Sheet" & ct).Move
ActiveWorkbook.SaveAs Filename:="D:\" & ActiveSheet.Name & ".csv", FileFormat:=xlCSV, _
CreateBackup:=False
ActiveWindow.Close
ct = ct - 1
Wend

ActiveWorkbook.SaveAs Filename:="D:\" & ActiveSheet.Name & ".csv", FileFormat:=xlCSV, _
CreateBackup:=False

MsgBox ("All sheets Saved")
End Sub

Hi Divan Please check this code.It will split the worksheets and save in csv format

[Divan]

Hi Gopika thank you for your reply I appreciate it I got the code to do what I want it to do except now it is saving 2 copies instead of one here is the code

Sub createcsv()
'
' createcsv Macro
' creates a csv from xl
'
Dim fs As Object, a As Object, i As Integer, s As String, t As String, l As String, mn As String, fileSaveName As String



Set fs = CreateObject("Scripting.FileSystemObject")

fileSaveName = Application.GetSaveAsFilename(fileFilter:="CSV files(*.CSV),*CSV")

If fileSaveName <> "false" Then
ActiveSheet.Copy
ActiveWorkbook.SaveAs

End If

Set a = fs.CreateTextFile(fileSaveName, True) 'filesavedailog box



For r = 1 To Range("A65536").End(xlUp).Row
s = ""
c = 1

While Not IsEmpty(Cells(r, c))
s = s & Cells(r, c) & ","
c = c + 1
Wend
a.writeline s 'write line

Next r

MsgBox "The job is done !", vbInformation

End Sub