Excel Macro Multiple Sheets to CSV

问题

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.ActiveWorkbook.SaveAs Filename: = xcsvFile, _
    FileFormat: = xlCSV, CreateBackup: = False

Here's the surrounding code:

Sub ExportSheetsToCSV()

    Dim xWs As Worksheet
    For Each xWs In Application.ActiveWorkbook.Worksheets

        xWs.Copy

        Dim xcsvFile As String
        xcsvFile = CurDir & "\" & xWs.Name & ".csv"

        Application.ActiveWorkbook.SaveAs Filename: = xcsvFile, _
            FileFormat: = xlCSV, CreateBackup: = False

        Application.ActiveWorkbook.Saved = True
        Application.ActiveWorkbook.Close

    Next

End Sub

回答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

回答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

来源：https://stackoverflow.com/questions/44783923/excel-macro-multiple-sheets-to-csv