【EXCEL VBA（マクロ）】アクティブシートをCSVファイルで保存する

アクティブシートをCSV保存する

Part１

Sub CSVファイル形式で保存()
    ' CSVファイル名を作成
    Dim csvFileName As String
    csvFileName = ThisWorkbook.Path & "\" & ActiveSheet.Name & ".csv"
    
    ' CSVファイルに保存
    ActiveSheet.SaveAs Filename:=csvFileName, _
        FileFormat:=xlCSV, _
        CreateBackup:=False
End Sub

このコードでは、まず保存先のパスとアクティブシートの名前からCSVファイル名を作成しています。その後、ActiveSheet.SaveAsメソッドを使用して、CSVファイルに保存しています。FileFormat引数にxlCSVを指定することで、CSVファイル形式で保存されます。また、CreateBackup引数にFalseを指定することで、バックアップファイルを作成しないようにしています。

なお、このコードでは、CSVファイルの文字コードが自動的に設定されます。文字コードを指定したい場合は、FileFormat引数にxlCSVUTF8などの定数を指定することで可能です。

Part２

Sub CSV_特定シートだけ別のフォルダに保存()

ThisWorkbook.ActiveSheet.Copy
ActiveWorkbook.SaveAs _
FileName:="パス名を表記" & "任意のファイル名_" & VBA.Format(Now, "yyyymmdd " & "hh-mm-ss"), _
FileFormat:=xlCSV

MsgBox "完了"
End Sub

Part３

Sub アクティブシートをCSV保存()
Const EXT As String = ".csv"
Dim ws As Worksheet
Set ws = ThisWorkbook.ActiveSheet  'Set ws = ThisWorkbook.Worksheets(1)

Dim nw As String
nw = VBA.Format(Now, "yyyymmdd " & "hh-mm-ss")


Dim csvFile As String
csvFile = ActiveWorkbook.path & "\" & "【CSV保存】_" & nw & ".csv"

Open csvFile For Output As #1

Dim i As Long, j As Long
i = 1

Do While ws.Cells(i, 1).Value <> ""

    j = 1
    Do While ws.Cells(i, j + 1).Value <> ""

        Print #1, ws.Cells(i, j).Value & ",";
        j = j + 1

    Loop

    Print #1, ws.Cells(i, j).Value & vbCr;
    i = i + 1

Loop

Close #1

MsgBox "data.csvに書き出しました"

End Sub

別のCSVファイルの最終行に追加して保存する

Sub CSVファイルに書き込み_最終行追加()

Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.ActiveSheet

Dim LastRow As Long
LastRow = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row

Dim LastCol As Long
LastCol = ws1.Cells(1, Columns.Count).End(xlToLeft).Column


'1列目から4列目の1行目から最終行までを定義
Dim trgtRng As Range
Set trgtRng = ws1.Range(ws1.Cells(1, 1), ws1.Cells(LastRow, LastCol))


'対象範囲の値を配列に格納
Dim outputAry As Variant
outputAry = trgtRng.Value

'保存先
Dim outputFile As String
outputFile = "C:\Users\y1ban\OneDrive\デスクトップ\CSVファイル保存.csv"

'空番号を取得
Dim trgtNum As Long
trgtNum = FreeFile

'書き込みのためにファイルを開く（ファイルがなければ作成される）
Open outputFile For Append As #trgtNum
    
    Dim i As Long
    Dim j As Long
    Dim trgtVal As String
    
    '行方向の要素数分ループ
    For i = LBound(outputAry, 1) To UBound(outputAry, 1)
        '列方向の要素数分ループ
        For j = LBound(outputAry, 2) To UBound(outputAry, 2)
            'シートの値を配列から定義
            trgtVal = outputAry(i, j)
            
            '値をファイルに書き込み
            If j = UBound(outputAry, 2) Then
                '最終列なら、「;」をつけない（「"；"」をつけると、改行なしで書き込み）
                Print #trgtNum, trgtVal
            Else
                '最終列でなければ、値の後に「","」末尾に「";"」をつける（「"；"」をつけると、改行なしで書き込み）
                Print #trgtNum, trgtVal & ",";
            End If
        Next
    Next

Close #trgtNum

MsgBox "完了"
End Sub