Need Help on Exporting Excel Sheet as CSV format

[spycein]

Hello Everyone,
Need your help to export custom worksheets of a workbook as a separate CSV file.
For example, I have 7 worksheets in my workbook, out of which I need to export only 2 sheets only. So, I need a macro which would prompt me to select sheet/sheets to export and select a folder to save the CSV files.
Thank you so much in advance.
Best Regards,
Shib

 

[nemmi69]

Sub ExportCSVs()
Dim Message As String
Dim Title As String
Dim Default As String
Dim Response As String
Dim ExCSVArr As Variant
Dim ExCSVLB As Integer
Dim ExCSVUB As Integer
Dim ExLoop As Integer
Dim FldrPicker As FileDialog
Dim myFolder As String
Dim ShtNum As Integer

Message = "Enter sheet numbers to export followed by a comma ( 2,5,7"    ' Set prompt.
Title = "Export Sheets selection"    ' Set title.
Default = ""    ' Set default.
' Display message, title, and default value.
Response = InputBox(Message, Title, Default)


If Trim(Response) = "" Then
    MsgBox "No sheets selected", vbInformation, Title
Else
    'Trim string to array
    
    ExCSVArr = Split(Response, ",")
    ExCSVLB = LBound(ExCSVArr)
    ExCSVUB = UBound(ExCSVArr)
    ' Select Folder to Save to with Dialog Box
    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
    
    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then 'Check if user clicked cancel button
            MsgBox "No folder path selected.", vbCritical, Title
            Exit Sub
        Else
            myFolder = .SelectedItems(1) & "\"
        End If
    End With
    ' Write sheets
    For ExLoop = ExCSVLB To ExCSVUB
        ShtNum = 0
        If IsNumeric(ExCSVArr(ExLoop)) = True Then ' Check if a number
            ShtNum = CInt(ExCSVArr(ExLoop))
            If ShtNum > 0 And ShtNum < Worksheets.Count Then ' Check that sheet number is valid
                ' Switch to sheet
                Sheets(CInt(ExCSVArr(ExLoop))).Select
                ' Export sheet as CSV
                ActiveWorkbook.SaveAs Filename:=myFolder & Sheets(CInt(ExCSVArr(ExLoop))).Name & ".csv", FileFormat:= _
                  xlCSV, CreateBackup:=False
            End If
        End If
    Next ExLoop
End If
End Sub

 

[spycein]

Sub ExportCSVs()
Dim Message As String
Dim Title As String
Dim Default As String
Dim Response As String
Dim ExCSVArr As Variant
Dim ExCSVLB As Integer
Dim ExCSVUB As Integer
Dim ExLoop As Integer
Dim FldrPicker As FileDialog
Dim myFolder As String
Dim ShtNum As Integer

Message = "Enter sheet numbers to export followed by a comma ( 2,5,7"    ' Set prompt.
Title = "Export Sheets selection"    ' Set title.
Default = ""    ' Set default.
' Display message, title, and default value.
Response = InputBox(Message, Title, Default)


If Trim(Response) = "" Then
    MsgBox "No sheets selected", vbInformation, Title
Else
    'Trim string to array
   
    ExCSVArr = Split(Response, ",")
    ExCSVLB = LBound(ExCSVArr)
    ExCSVUB = UBound(ExCSVArr)
    ' Select Folder to Save to with Dialog Box
    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
   
    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then 'Check if user clicked cancel button
            MsgBox "No folder path selected.", vbCritical, Title
            Exit Sub
        Else
            myFolder = .SelectedItems(1) & "\"
        End If
    End With
    ' Write sheets
    For ExLoop = ExCSVLB To ExCSVUB
        ShtNum = 0
        If IsNumeric(ExCSVArr(ExLoop)) = True Then ' Check if a number
            ShtNum = CInt(ExCSVArr(ExLoop))
            If ShtNum > 0 And ShtNum < Worksheets.Count Then ' Check that sheet number is valid
                ' Switch to sheet
                Sheets(CInt(ExCSVArr(ExLoop))).Select
                ' Export sheet as CSV
                ActiveWorkbook.SaveAs Filename:=myFolder & Sheets(CInt(ExCSVArr(ExLoop))).Name & ".csv", FileFormat:= _
                  xlCSV, CreateBackup:=False
            End If
        End If
    Next ExLoop
End If
End Sub

Thank you so much @nemmi69 for your help. The code works well until sheet number 7. If i put 8 then nothing happens.
Could you please help me on this.
Best Regards,

 

[nemmi69]

Are there 8 sheets? Worksheets.Count stops numbers being used that are more than the actual number of sheets.

 

[spycein]

Sub ExportCSVs()
Dim Message As String
Dim Title As String
Dim Default As String
Dim Response As String
Dim ExCSVArr As Variant
Dim ExCSVLB As Integer
Dim ExCSVUB As Integer
Dim ExLoop As Integer
Dim FldrPicker As FileDialog
Dim myFolder As String
Dim ShtNum As Integer

Message = "Enter sheet numbers to export followed by a comma ( 2,5,7"    ' Set prompt.
Title = "Export Sheets selection"    ' Set title.
Default = ""    ' Set default.
' Display message, title, and default value.
Response = InputBox(Message, Title, Default)


If Trim(Response) = "" Then
    MsgBox "No sheets selected", vbInformation, Title
Else
    'Trim string to array
   
    ExCSVArr = Split(Response, ",")
    ExCSVLB = LBound(ExCSVArr)
    ExCSVUB = UBound(ExCSVArr)
    ' Select Folder to Save to with Dialog Box
    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
   
    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then 'Check if user clicked cancel button
            MsgBox "No folder path selected.", vbCritical, Title
            Exit Sub
        Else
            myFolder = .SelectedItems(1) & "\"
        End If
    End With
    ' Write sheets
    For ExLoop = ExCSVLB To ExCSVUB
        ShtNum = 0
        If IsNumeric(ExCSVArr(ExLoop)) = True Then ' Check if a number
            ShtNum = CInt(ExCSVArr(ExLoop))
            If ShtNum > 0 And ShtNum < Worksheets.Count Then ' Check that sheet number is valid
                ' Switch to sheet
                Sheets(CInt(ExCSVArr(ExLoop))).Select
                ' Export sheet as CSV
                ActiveWorkbook.SaveAs Filename:=myFolder & Sheets(CInt(ExCSVArr(ExLoop))).Name & ".csv", FileFormat:= _
                  xlCSV, CreateBackup:=False
            End If
        End If
    Next ExLoop
End If
End Sub

Issue got sorted.. Thank you so much.

 

[nemmi69]

No prob.