【VBA】複数CSVを個別シートに読み込むマクロ【ファイル名で自動命名】

▼完成イメージ

• 複数CSVを選択
• 各CSVの中身が新しいシートに1枚ずつ展開される
• シート名は元のCSVファイル名になる

▼コード全文（そのままコピペOK）

Sub ImportCSVToSeparateSheets()
    Dim csvFiles As Variant
    Dim i As Long
    Dim tempWB As Workbook
    Dim tempWS As Worksheet
    Dim newWS As Worksheet
    Dim fileName As String

    ' CSVファイルを複数選択
    csvFiles = Application.GetOpenFilename("CSVファイル (*.csv),*.csv", _
                                           Title:="CSVファイルを選択（複数可）", _
                                           MultiSelect:=True)

    If VarType(csvFiles) = vbBoolean Then
        MsgBox "キャンセルされました。", vbExclamation
        Exit Sub
    End If

    Application.ScreenUpdating = False

    For i = LBound(csvFiles) To UBound(csvFiles)
        Set tempWB = Workbooks.Open(Filename:=csvFiles(i), ReadOnly:=True)
        Set tempWS = tempWB.Sheets(1)

        ' ファイル名（拡張子抜き）を取得
        fileName = VBA.Replace(VBA.Mid(csvFiles(i), InStrRev(csvFiles(i), "\") + 1), ".csv", "")

        ' シートを追加し、名前をファイル名に
        Set newWS = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        On Error Resume Next
        newWS.Name = Left(fileName, 31) ' Excelのシート名上限：31文字
        On Error GoTo 0

        ' データをコピー
        tempWS.UsedRange.Copy Destination:=newWS.Range("A1")

        tempWB.Close SaveChanges:=False
    Next i

    Application.ScreenUpdating = True

    MsgBox "すべてのCSVファイルを読み込みました！", vbInformation
End Sub

▼ポイント解説

処理項目	内容
GetOpenFilename	CSVを複数同時に選択可能
Workbooks.Open	一時的にCSVをブックとして開く
Sheets.Add	新しいシートを追加
UsedRange.Copy	データをすべてコピー
newWS.Name	シート名をCSVのファイル名に自動で設定（31文字以内）

▼実務での活用パターン

• 部署別・月別・担当者別のCSV を一括整理
• 毎日分割されて届く帳票 を一括で読み込み
• 個別ファイルの印刷用フォーマット への差し込み展開にも応用可能

▼よくあるカスタマイズ案

カスタマイズ	方法例
ヘッダーを除外して読み込みたい	.UsedRange.Offset(1, 0).Resize(...).Copy に変更
ファイル名＋日付でシート名をつけたい	newWS.Name = Format(Now, "yyyymmdd") & "_" & Left(fileName, 20)
空シートがあるときに削除	If WorksheetFunction.CountA(newWS.Cells) = 0 Then newWS.Delete

▼まとめ

このマクロを使えば、複数のCSVファイルを一気に読み込み、それぞれが独立したシートに自動で展開されます。
データの分類・加工・印刷・保存がしやすくなり、業務効率が格段にアップします。