「自分の業務に近いサンプルがほしい」
「一からマクロを組むのはキツい。ほぼ完成品がほしい」
そんな方のために、この記事では実務でよくあるシナリオを丸ごとVBAで再現します。
- 日次・月次の定型処理
- ファイル集約・転記
- 顧客リスト加工
- 売上集計レポート作成
- メール送信（Outlook連携）
など、「こういうの欲しかった」系を全部のせしました。
目次
1. 日次レポートをテンプレから自動作成する
想定シナリオ
report_template.xlsxというテンプレートファイルがある- 毎日、そのテンプレをコピーして
- 日付入りのファイル名を付けて
- 所定フォルダに保存したい
コード
VB
Option Explicit
Sub CreateDailyReport()
Dim tmplPath As String
Dim saveFolder As String
Dim todayStr As String
Dim wb As Workbook
' テンプレートと保存先フォルダのパスを指定
tmplPath = ThisWorkbook.Path & "\report_template.xlsx"
saveFolder = ThisWorkbook.Path & "\日次レポート"
' フォルダがなければ作成
If Dir(saveFolder, vbDirectory) = "" Then
MkDir saveFolder
End If
' 日付文字列（例：2025-11-23）
todayStr = Format(Date, "yyyy-mm-dd")
' テンプレートを開く
Set wb = Workbooks.Open(tmplPath)
' 日付入りの名前で保存
wb.SaveAs Filename:=saveFolder & "\日次レポート_" & todayStr & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook ' xlsx
' 必要であれば、作成者や日付をシート上に書く例
With wb.Sheets(1)
.Range("B2").Value = Date ' 作成日
.Range("B3").Value = Environ("UserName") ' 担当者名（Windowsログイン名）
End With
' 保存済みなので閉じる（開いたままにしたいなら Close を削る）
wb.Close SaveChanges:=True
MsgBox "本日分の日次レポートを作成しました。", vbInformation
End Sub解説
tmplPath：テンプレファイルのパスsaveFolder：日次レポートの保存フォルダMkDir：フォルダがなければ作成Format(Date, "yyyy-mm-dd")：日付をファイル名用に整形
応用アイデア
- 週次・月次レポートにも流用（
DateをDateSerial＋Year/Monthで加工） - 部署ごとにテンプレートを切り替える（引数でテンプレ名を変える）
2. 複数ファイルのデータを1枚の集計シートにまとめる
想定シナリオ
- フォルダ内に各店舗・各担当者のExcelファイルがある
- どのファイルも「Sheet1」に同じ形式でデータがある
- すべてを1つの「集計」シートに縦方向に結合したい
コード
VB
Option Explicit
Sub MergeFilesToSummary()
Dim targetFolder As String
Dim fName As String
Dim wb As Workbook
Dim wsSrc As Worksheet
Dim wsDst As Worksheet
Dim lastRowDst As Long
Dim lastRowSrc As Long
' 集計先シートを用意（なければ作成）
On Error Resume Next
Set wsDst = ThisWorkbook.Worksheets("集計")
On Error GoTo 0
If wsDst Is Nothing Then
Set wsDst = ThisWorkbook.Worksheets.Add
wsDst.Name = "集計"
Else
' 既存データリセット（ヘッダー行を残したいなら 2行目以降をクリア）
wsDst.Cells.Clear
End If
' フォルダパスを指定
targetFolder = ThisWorkbook.Path & "\店舗別"
' ヘッダー行を書く（適宜変更）
wsDst.Range("A1").Value = "店舗名"
wsDst.Range("B1").Value = "日付"
wsDst.Range("C1").Value = "売上"
lastRowDst = 2 ' データ開始行
' フォルダ内のExcelファイルをループ
fName = Dir(targetFolder & "\*.xlsx")
Do While fName <> ""
Set wb = Workbooks.Open(targetFolder & "\" & fName)
Set wsSrc = wb.Worksheets("Sheet1")
' 元ファイルの最終行を取得（1列目基準）
lastRowSrc = wsSrc.Cells(wsSrc.Rows.Count, "A").End(xlUp).Row
' データがあればコピー
If lastRowSrc >= 2 Then
' コピー元：A2:C最終行
wsSrc.Range("A2:C" & lastRowSrc).Copy _
Destination:=wsDst.Range("A" & lastRowDst)
' 転記先の最終行更新
lastRowDst = wsDst.Cells(wsDst.Rows.Count, "A").End(xlUp).Row + 1
End If
wb.Close SaveChanges:=False
fName = Dir
Loop
MsgBox "集計が完了しました。", vbInformation
End Sub解説
Dirを使って、指定フォルダ内の*.xlsxを順番に取得- 各ファイルの
Sheet1を開いて、A～C列のデータを「集計」シートへ転記 - ヘッダー行は「集計」側に1回だけ書く
応用アイデア
- 店舗名をファイル名から自動抽出して追加列に書く
- 日付でフィルタして、当月分だけ集計する
3. 顧客リストから「有効な行だけ」抽出して新ファイルに保存
想定シナリオ
- 顧客リストのシートに
- 既に解約済み
- メールアドレスなし
- フラグ列で「無効」が入っている
行が混在している - 「有効な顧客だけ」のリストを別ファイルにして共有したい
コード
VB
Option Explicit
Sub ExportActiveCustomers()
Dim wsSrc As Worksheet
Dim wbNew As Workbook
Dim wsNew As Worksheet
Dim lastRowSrc As Long
Dim lastRowNew As Long
Dim i As Long
Set wsSrc = ThisWorkbook.Worksheets("顧客マスタ")
' 新しいブックを作成
Set wbNew = Workbooks.Add
Set wsNew = wbNew.Sheets(1)
wsNew.Name = "有効顧客"
' ソースの最終行
lastRowSrc = wsSrc.Cells(wsSrc.Rows.Count, "A").End(xlUp).Row
' ヘッダー行コピー
wsSrc.Range("A1:D1").Copy Destination:=wsNew.Range("A1")
lastRowNew = 2
' A列：顧客ID, B列：氏名, C列：メール, D列：ステータス
For i = 2 To lastRowSrc
Dim status As String
Dim mail As String
status = wsSrc.Cells(i, "D").Value
mail = wsSrc.Cells(i, "C").Value
' 条件：ステータス=有効 かつ メールアドレスが空白でない
If status = "有効" And mail <> "" Then
wsSrc.Range("A" & i & ":D" & i).Copy _
Destination:=wsNew.Range("A" & lastRowNew)
lastRowNew = lastRowNew + 1
End If
Next i
' 保存ダイアログを出す
Dim savePath As Variant
savePath = Application.GetSaveAsFilename( _
InitialFileName:="有効顧客_" & Format(Date, "yyyymmdd") & ".xlsx", _
FileFilter:="Excelファイル (*.xlsx), *.xlsx")
If savePath <> False Then
wbNew.SaveAs Filename:=savePath, FileFormat:=xlOpenXMLWorkbook
wbNew.Close SaveChanges:=False
MsgBox "有効顧客リストを出力しました。", vbInformation
Else
wbNew.Close SaveChanges:=False
MsgBox "保存はキャンセルされました。", vbExclamation
End If
End Sub解説
- 条件判定を
If status = "有効" And mail <> "" Thenで行い、「使える顧客だけ」を抽出 GetSaveAsFilenameを使うことで、ユーザーに保存場所を選んでもらえる
応用アイデア
- ステータスを複数条件にする（「有効」「休眠」など）
- メールアドレスの形式チェック（
InStr(mail, "@") > 0など）
4. 売上データからピボット風レポートを自動作成
想定シナリオ
- 明細シートに「日付 / 店舗 / 商品 / 数量 / 金額」が入っている
- 「店舗 × 商品」で売上合計をまとめたレポートを作りたい
- 本当はピボットテーブルでも良いが、「コードでやりたい」ケース
コード
VB
Option Explicit
Sub CreateSalesReport()
Dim wsSrc As Worksheet
Dim wsRpt As Worksheet
Dim lastRow As Long
Dim dictKey As Object
Dim dictVal As Object
Dim i As Long
Dim key As Variant
Set wsSrc = ThisWorkbook.Worksheets("売上明細")
' レポートシートを用意
On Error Resume Next
Set wsRpt = ThisWorkbook.Worksheets("売上レポート")
On Error GoTo 0
If wsRpt Is Nothing Then
Set wsRpt = ThisWorkbook.Worksheets.Add
wsRpt.Name = "売上レポート"
Else
wsRpt.Cells.Clear
End If
' Dictionaryを使って「店舗×商品」ごとの売上合計を集計
Set dictKey = CreateObject("Scripting.Dictionary")
Set dictVal = CreateObject("Scripting.Dictionary")
lastRow = wsSrc.Cells(wsSrc.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
Dim storeName As String
Dim itemName As String
Dim amount As Double
Dim compositeKey As String
storeName = wsSrc.Cells(i, "B").Value ' 店舗
itemName = wsSrc.Cells(i, "C").Value ' 商品
amount = wsSrc.Cells(i, "E").Value ' 金額
compositeKey = storeName & "||" & itemName
If Not dictKey.Exists(compositeKey) Then
dictKey.Add compositeKey, compositeKey
dictVal.Add compositeKey, amount
Else
dictVal(compositeKey) = dictVal(compositeKey) + amount
End If
Next i
' レポート出力
wsRpt.Range("A1").Value = "店舗"
wsRpt.Range("B1").Value = "商品"
wsRpt.Range("C1").Value = "売上合計"
Dim rowRpt As Long
rowRpt = 2
For Each key In dictKey.Keys
Dim parts() As String
parts = Split(key, "||")
wsRpt.Cells(rowRpt, 1).Value = parts(0) ' 店舗
wsRpt.Cells(rowRpt, 2).Value = parts(1) ' 商品
wsRpt.Cells(rowRpt, 3).Value = dictVal(key) ' 売上合計
rowRpt = rowRpt + 1
Next key
' 見栄え調整
wsRpt.Columns("A:C").AutoFit
MsgBox "売上レポートを作成しました。", vbInformation
End Sub解説
Dictionaryでキー（店舗×商品）ごとに金額を合計compositeKey = storeName & "||" & itemNameのように区切り文字を挟んでユニークキーを生成
応用アイデア
- 年月別（「店舗 × 商品 × 年月」）のキーにする
- 一定金額以上の商品だけ抽出して「売れ筋商品リスト」を作る
5. 見積書をPDF化して自動保存
想定シナリオ
- 見積書シートをPDFにして社内・社外に配布している
- 毎回「名前をつけてPDF保存」が面倒
- シート名＋顧客名＋日付をPDFファイル名にして自動保存したい
コード
VB
Option Explicit
Sub ExportEstimateAsPDF()
Dim ws As Worksheet
Dim pdfFolder As String
Dim pdfName As String
Dim clientName As String
Dim todayStr As String
Set ws = ThisWorkbook.Worksheets("見積書")
' 顧客名はシート上のセルから取得（例：B4）
clientName = ws.Range("B4").Value
todayStr = Format(Date, "yyyymmdd")
' 保存先フォルダ
pdfFolder = ThisWorkbook.Path & "\PDF"
If Dir(pdfFolder, vbDirectory) = "" Then
MkDir pdfFolder
End If
' ファイル名組み立て
pdfName = pdfFolder & "\" & "見積書_" & clientName & "_" & todayStr & ".pdf"
' PDFとしてエクスポート
ws.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=pdfName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "見積書をPDF出力しました。" & vbCrLf & pdfName, vbInformation
End Sub解説
ExportAsFixedFormatで簡単にPDF書き出し- 顧客名をセルから取ることで、ファイル名から内容が分かりやすい
応用アイデア
OpenAfterPublish:=Trueにして、PDF出力後に自動で開く- 日付ではなく見積番号で管理する（見積番号セルを読み取る）
6. 集計結果をOutlookメールで自動送信
想定シナリオ
- 集計した結果を、毎日 or 毎週メールでチームに共有している
- 本文に今日の売上や件数を差し込みたい
- Outlookを利用している環境
コード
VB
Option Explicit
Sub SendSummaryByMail()
Dim ws As Worksheet
Dim totalSales As Double
Dim totalCount As Long
' 集計シートから数値を取得（例：B2に売上合計、B3に件数）
Set ws = ThisWorkbook.Worksheets("サマリー")
totalSales = ws.Range("B2").Value
totalCount = ws.Range("B3").Value
' Outlookオブジェクト
Dim olApp As Object
Dim olMail As Object
' Outlookを起動 or 既に起動しているインスタンスを取得
On Error Resume Next
Set olApp = GetObject(Class:="Outlook.Application")
If olApp Is Nothing Then
Set olApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0
If olApp Is Nothing Then
MsgBox "Outlookを起動できませんでした。", vbCritical
Exit Sub
End If
' 新規メール作成
Set olMail = olApp.CreateItem(0) ' olMailItem
With olMail
.To = "example@example.com" ' 宛先（カンマ区切りで複数指定可）
.CC = ""
.Subject = "【日次報告】売上サマリー " & Format(Date, "yyyy/mm/dd")
.Body = "お疲れ様です。" & vbCrLf & vbCrLf & _
"本日の売上サマリーです。" & vbCrLf & _
"-------------------------" & vbCrLf & _
"売上合計：" & Format(totalSales, "#,##0") & " 円" & vbCrLf & _
"件数 ：" & totalCount & " 件" & vbCrLf & _
"-------------------------" & vbCrLf & vbCrLf & _
"詳細は添付のExcelファイルをご確認ください。" & vbCrLf & _
"よろしくお願いいたします。"
' このブック自体を添付する例
.Attachments.Add ThisWorkbook.FullName
.Display ' すぐ送信するなら .Send
End With
MsgBox "メール作成が完了しました（送信前に内容を確認してください）。", vbInformation
End Sub解説
GetObject＋CreateObjectでOutlookオブジェクトを取得.Displayでメール作成画面を表示（いきなり送信したいなら.Send）- 集計値を本文中に差し込んで、読まれる報告メールにする
応用アイデア
- 宛先をシートから読み込んで柔軟に変更
- 曜日でメール件名を変える（例：月曜日は週次レポート）
まとめ：実務シナリオから「パクってカスタマイズ」するのが最速
この記事で紹介したのは、実務で頻出のシナリオばかりです。
- テンプレから日次レポートを作る
- 複数ファイルからデータを集約する
- 顧客リストを条件抽出する
- 売上明細から集計レポートを作る
- 見積書シートをPDF化する
- 集計結果をメール送信する
まずは「一行も書かずに、コピペして項目だけ自分の業務用に変える」ところから始めてみてください。
そのうち、
「ここも自動化したいな」
「条件を増やしたいな」
と自然に思えるので、そこからが“自分用VBA”のスタートです。
コメント