Excel Macro Multiple Sheets to CSV

后端 未结 2 1071
夕颜
夕颜 2020-12-12 07:06

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         


        
2条回答
  •  挽巷
    挽巷 (楼主)
    2020-12-12 07:52

    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
    

提交回复
热议问题