Excel宏多页到CSV

Question

我有一个宏，我在Excel中运行，将49张纸分成单独的CSV文件。

然而，它正赶上第7行

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

这是周围的代码：

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

Answer 1

对于工作簿中的每个工作表，传输每个工作表的名称csv文件。

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

考虑一下。

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