Excel Macro Multiple Sheets to CSV

Question

I have a macro that I am running in Excel to separate 49 sheets into individual CSV files.

However, it is getting caught up on line 7

Application.A         


        

Answer 1

For each Sheet in workbook, transfer each sheet's name csv file.

Sub ExportSheetsToCSV()

    Dim Ws As Worksheet
    Dim xcsvFile As String
    Dim rngDB As Range

    For Each Ws In Worksheets
        xcsvFile = CurDir & "\" & Ws.Name & ".csv"
        With Ws
            r = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            c = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
            Set rngDB = .Range("a1", .Cells(r, c))
        End With
        TransToCSV xcsvFile, rngDB
    Next
    MsgBox ("Files Saved Successfully")
End Sub

Sub TransToCSV(myfile As String, rng As Range)

    Dim vDB, vR() As String, vTxt()
    Dim i As Long, n As Long, j As Integer
    Dim objStream
    Dim strTxt As String

    Set objStream = CreateObject("ADODB.Stream")
    vDB = rng
    For i = 1 To UBound(vDB, 1)
        n = n + 1
        ReDim vR(1 To UBound(vDB, 2))
        For j = 1 To UBound(vDB, 2)
            vR(j) = vDB(i, j)
        Next j
        ReDim Preserve vTxt(1 To n)
        vTxt(n) = Join(vR, ",")
    Next i
    strTxt = Join(vTxt, vbCrLf)
    With objStream
        '.Charset = "utf-8"
        .Open
        .WriteText strTxt
        .SaveToFile myfile, 2
        .Close
    End With
    Set objStream = Nothing

End Sub

Answer 2

Consider this.

Sub test()

    Dim ws As Worksheet
    Dim GetSheetName As String

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Sheet1" Then ' Assuming there is one sheet that you DON'T want to save as a CSV

        ws.Select
        GetSheetName = ActiveSheet.Name
            Set shtToExport = ActiveSheet     ' Sheet to export as CSV
                Set wbkExport = Application.Workbooks.Add
                shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
                Application.DisplayAlerts = False       ' Possibly overwrite without asking
                wbkExport.SaveAs Filename:="C:\your_path_here\Desktop\" & GetSheetName & ".csv", FileFormat:=xlCSV
                Application.DisplayAlerts = True
                wbkExport.Close SaveChanges:=False

        End If
    Next ws

End Sub