EXCEL-VBA如何導出到CSV…自定義列范圍？

將列導出到CSV

• 調整常量部分中的值。
• 如果列表分隔符是分號，則可能需要使用Local:=True。

Option Explicit

Sub ExportColumnsToCSV()
    
    Const sfRow As Long = 1
    Const sColsList As String = "A:F,H:I,V,AM:AV"
    
    Const dFirst As String = "A1"
    
    
    Dim sCols() As String: sCols = Split(sColsList, ",")
    
    Dim sws As Worksheet: Set sws = ActiveSheet
    Dim swb As Workbook: Set swb = sws.Parent
    
    Dim srrg As Range
    Dim slCell As Range
    Dim srCount As Long
    
    With sws.Rows(sfRow)
        Set slCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , xlByRows, xlPrevious)
        If slCell Is Nothing Then
            MsgBox "No data in worksheet.", vbCritical, "Export to CSV"
            Exit Sub
        End If
        srCount = slCell.Row - .Row + 1
        Set srrg = .Resize(srCount)
    End With
    
    Dim srg As Range
    Dim n As Long
    
    For n = 0 To UBound(sCols)
        If srg Is Nothing Then
            Set srg = Intersect(srrg, sws.Columns(sCols(n)))
        Else
            Set srg = Union(srg, Intersect(srrg, sws.Columns(sCols(n))))
        End If
    Next n
    
    Dim dwb As Workbook: Set dwb = Application.Workbooks.Add
    srg.Copy
    dwb.Worksheets(1).Range(dFirst).PasteSpecial xlPasteValues
    
    Dim dFolderPath As String: dFolderPath = swb.Path & "\Folder\"
    
    On Error Resume Next
    MkDir dFolderPath
    On Error GoTo 0
    
    Dim dFilePath As String
    dFilePath = dFolderPath _
        & Left(swb.Name, InStrRev(swb.Name, ".") - 1) & ".csv"
    ' Optionally, out-comment previous line and uncomment next one
    ' to save with the current worksheet name.
    'dFilePath = dFolderPath & sws.Name & ".csv"

    Application.DisplayAlerts = False
    dwb.SaveAs Filename:=dFilePath, FileFormat:=xlCSVUTF8, Local:=False
    dwb.Close SaveChanges:=False
    Application.DisplayAlerts = True

End Sub