Excel VBA で顧客別に売上データを自動分割し、シートへ転記する方法

2025年8月3日

概要

AdvancedFilter を VBA で活用すると、売上表を顧客ごとに抽出し、シートを自動生成して転記する作業を完全自動化できます。本稿では、次の流れを一括で実行するサンプルコードを丁寧に解説いたします。

元データから顧客名のユニークリストを作成
顧客名を 1 件ずつ条件範囲へ設定
各顧客専用シートを生成し、売上明細を転記

前提条件

項目	内容
対応 Excel	Microsoft 365 もしくは 2016 以降
元データ	シート Sales、セル A1 起点（列見出し＋売上明細）
顧客列	4 列目（D 列）
マクロ配置	標準モジュール

サンプルコード（VBA）

Sub SplitSalesByCustomer()

    Dim srcArea     As Range      ' 元データ全体
    Dim critTopCell As Range      ' 条件範囲の左上セル
    Dim custList    As Range      ' 顧客ユニークリスト
    Dim wsNew       As Worksheet  ' 生成シート
    Dim idx         As Long       ' ループ用カウンター
    Dim keyCol      As Long       ' 顧客列番号
    
    '--- 元データ範囲と顧客列を設定 ---
    Set srcArea = Worksheets("Sales").Range("A1").CurrentRegion
    keyCol = 4                                   ' D 列（顧客）
    
    '--- 条件範囲用セルを元データの右隣へ配置 ---
    Set critTopCell = srcArea.Cells(1).Offset(0, srcArea.Columns.Count + 1)
    
    '--- 既存の条件・リストをクリア ---
    critTopCell.CurrentRegion.Clear
    
    '--- 顧客列のユニーク値を抽出（ヘッダー＋明細列）---
    srcArea.Columns(keyCol).AdvancedFilter _
        Action:=xlFilterCopy, _
        CopyToRange:=critTopCell, _
        Unique:=True
    
    '--- 顧客ユニークリスト（見出し含む）を再取得 ---
    Set custList = critTopCell.CurrentRegion
    
    '--- 顧客ごとにシートを作成し、売上を転記 ---
    For idx = 2 To custList.Rows.Count          ' 2 行目から末尾まで
        ' 条件行を更新
        critTopCell.Offset(1).Value = custList.Cells(idx, 1).Value
        
        ' 新規シートを末尾へ追加
        Set wsNew = Worksheets.Add(After:=Worksheets(Worksheets.Count))
        wsNew.Name = critTopCell.Offset(1).Value
        
        ' AdvancedFilter で顧客別明細をコピー
        srcArea.AdvancedFilter _
            Action:=xlFilterCopy, _
            CriteriaRange:=critTopCell.Resize(2, 1), _
            CopyToRange:=wsNew.Range("A1")
        
        ' 列幅を自動調整
        wsNew.Range("A1").CurrentRegion.EntireColumn.AutoFit
    Next idx
    
    '--- 作業列をクリア ---
    critTopCell.CurrentRegion.Clear
    
    MsgBox "顧客別シートの作成が完了しました。", vbInformation

End Sub

コード詳細解説

行	説明
9–11	`srcArea` に売上表全体を格納し、`keyCol = 4` で顧客列を指定しています。
14	`critTopCell` は元データの右隣に配置し、条件範囲とユニークリストの両方に流用します。
19–23	顧客列を `Unique:=True` で抽出し、重複の無いリストを作成しています。
29–40	ループで顧客名を 1 行ずつ条件範囲へ設定し、新規シートを作成して売上明細を転記します。
34–37	`CriteriaRange` を 2 行（見出し＋顧客名）のみに限定し、該当顧客だけを抽出しています。
42	最後に作業用セルをクリアし、ブックをクリーンな状態へ戻しています。

応用アイデア

要件	アプローチ
明細のない顧客シートをスキップしたい	`If wsNew.Range("A2") = "" Then Application.DisplayAlerts=False: wsNew.Delete: Application.DisplayAlerts=True`
シート名が重複する可能性への対処	作成前に `WorksheetExists` 関数で存在確認し、末尾に連番を付ける方法が有効です。
ファイル分割で保存したい	`wsNew.Copy` の後に `ActiveWorkbook.SaveAs` で個別ブックへ保存できます。

まとめ

AdvancedFilter の xlFilterCopy と Unique:=True、そして条件範囲を動的に書き換える手法を組み合わせることで、顧客別に売上明細を自動分割し、それぞれ専用シートへ転記するタスクをワンクリックで実現できます。ぜひご自身の売上管理や請求書作成の自動化にお役立てください。

よかったらシェアしてね！