A子さん複数のCSVを毎回1つずつ手作業で開いている
データを1つのシートにまとめて集計したい
毎日の業務処理を自動化したい
結論:CSVファイルが多くてもまとめてしまえば集計可能です。
目次
▼完成イメージ
- 実行するとCSVファイルを複数選択できる
- 各CSVの内容を順に読み込んで、一つのシートに下に連結していく
- 各ファイルの間には区切り行を入れることも可能
▼コード全体(そのまま貼り付けOK)
Sub ImportMultipleCSV()
Dim csvFiles As Variant
Dim i As Long
Dim lastRow As Long
Dim tempWB As Workbook
Dim targetWS As Worksheet
' 複数CSVファイルを選択
csvFiles = Application.GetOpenFilename("CSVファイル (*.csv),*.csv", _
Title:="CSVファイルを選択(複数可)", _
MultiSelect:=True)
If VarType(csvFiles) = vbBoolean Then
MsgBox "キャンセルされました。", vbExclamation
Exit Sub
End If
Set targetWS = ThisWorkbook.Sheets(1) ' 貼り付け先は1枚目のシートとする
targetWS.Cells.Clear ' 事前にクリア
Application.ScreenUpdating = False
For i = LBound(csvFiles) To UBound(csvFiles)
Set tempWB = Workbooks.Open(Filename:=csvFiles(i), ReadOnly:=True)
' 貼り付け先の最後の行を取得
lastRow = targetWS.Cells(targetWS.Rows.Count, 1).End(xlUp).Row
If lastRow > 1 Or targetWS.Cells(1, 1).Value <> "" Then
lastRow = lastRow + 1
End If
' コピー&貼り付け
tempWB.Sheets(1).UsedRange.Copy Destination:=targetWS.Cells(lastRow, 1)
tempWB.Close SaveChanges:=False
Next i
Application.ScreenUpdating = True
MsgBox "CSVファイルの読み込みが完了しました!", vbInformation
End Sub
▼マクロのポイント解説
| 処理パート | 内容 |
|---|---|
GetOpenFilename | 複数ファイル選択を可能にする(MultiSelect:=True) |
UsedRange.Copy | CSVの中身を丸ごと貼り付ける |
lastRow = … | データの下に順次追加していく |
Application.ScreenUpdating | 画面のチラつきを防ぐ(高速化にも有効) |
▼使い方のコツ
- データの構造が各CSVで統一されていると理想(ヘッダー付きCSVは一工夫必要)
- まとめる前にシートの中身をクリアしておく(
Cells.Clear)ことで、前回のデータを消せる - 「日付別に集約したい」「ファイル名を1列目に追加したい」などの応用も可能です
▼よくあるカスタマイズ案
| カスタマイズ内容 | 方法 |
|---|---|
| 各CSVのヘッダーをスキップ | UsedRange.Offset(1, 0).Resize(UsedRange.Rows.Count - 1).Copy |
| ファイル名を追加したい | targetWS.Cells(lastRow, 1).Value = Dir(csvFiles(i)) を追記など |
| 各CSVの内容を別シートに貼る | Worksheets.Add で新規シートを作成して1つずつ貼る |
▼まとめ
複数のCSVファイルを手作業で開くのは非効率!
VBAを使えば、ワンクリックで全ファイルをまとめて読み込み、自動的に整形された集計シートが完成します。

コメント