Excel VBAで、複数の特定範囲をCSVに保存するマクロ

会社で使用するために作成したものを、そのまま張り付けましたので
ファイル名や、場所は変更して使用してください。

１つの、シート内のデータを複数のcsvファイルに保存するのに便利です。
手作業でも可能ですが、数十件以上あり、さすがに面倒なので作成しました。

実行方法

・E１に「フォルダーパス」を入力する

・VBAエディタを起動します（Alt + F11キー）。

・「挿入」メニューから「モジュール」を選択して、新しいモジュールを作　成します。

・下記のコードをモジュールウィンドウに貼り付けます。

・マクロを実行します（Alt + F8キー、作成したマクロを選択して「実行」）。

Sub SaveRangesAsCSV()
    Dim wb As Workbook
    Dim sourceSheet As Worksheet
    Dim folderPath As String
    Dim filePath As String
    Dim csvFileName As String
    Dim arrFileNames As Variant
    Dim arrColumns As Variant
    Dim i As Integer
    
    ' 初期設定
    arrFileNames = Array("item.csv", "item-cat.csv", "data_add.csv", "S_マスタ_メイン.csv", "S_マスタ_価格情報.csv", "S_マスタ_車両情報.csv", "data_spy.csv", "quantity.csv", "S_マスタ_楽天.csv", "S_マスタ_ヤフー.csv", "S_マスタ_サイズ情報.csv", "S_マスタ_商品情報.csv", "normal-item.csv")
    arrColumns = Array("E:AF", "AM:AT", "BA:CT", "CZ:DB", "DG:DO", "DS:DW", "EA:ET", "EZ:FB", "FH:FI", "FL:FN", "FR:FS", "FV:FW", "GB:UX")
    
    ' フォルダーパスをE1セルから取得
    folderPath = ThisWorkbook.Sheets(1).Range("E1").Value
    
    ' 対象のワークブックとシートを設定
    Set wb = Workbooks.Open(folderPath & "\元.xlsx")
    Set sourceSheet = wb.Sheets(1)
    
    ' 各ファイル名と範囲に対してループ
    For i = LBound(arrFileNames) To UBound(arrFileNames)
        csvFileName = folderPath & "\" & arrFileNames(i)
        ' SaveRangeAsCSVを呼び出す
        SaveRangeAsCSV sourceSheet, arrColumns(i), csvFileName
    Next i
    
    wb.Close False ' ワークブックを保存せずに閉じる
End Sub

Sub SaveRangeAsCSV(sourceSheet As Worksheet, ByVal colRange As String, csvFileName As String)
    Dim rng As Range
    Dim csvWorkbook As Workbook
    Dim csvSheet As Worksheet
    
    ' 対象範囲を選択
    Set rng = sourceSheet.Range(colRange)
    
    ' 新しいワークブックを作成し、範囲をコピー
    Set csvWorkbook = Workbooks.Add
    With csvWorkbook
        Set csvSheet = .Sheets(1)
        rng.Copy
        
        ' 新しいシートのA1セルに貼り付け
        csvSheet.Cells(1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        
        ' CSVとして保存
        .SaveAs Filename:=csvFileName, FileFormat:=xlCSV
        
        ' 新しいワークブックを閉じる
        .Close False
    End With
End Sub