完成イメージ（Before / After）
Before（手動フィルター）
| A | B | C | D | |
|---|---|---|---|---|
| 1 | 日付 | 部門 | 項目 | 金額 |
| 2 | 2026/03/05 | 営業部 | 交通費 | 15000 |
| 3 | 2026/03/10 | 総務部 | 備品 | 8000 |
| 4 | 2026/04/01 | 営業部 | 会議費 | 12000 |
| 5 | 2026/04/15 | 製造部 | 材料費 | 45000 |
毎回手動でフィルター設定→コピー→貼り付けを繰り返す。日付範囲の設定ミスも起きる。
After（VBAで自動抽出 → 別シートにコピー）
| A | B | C | D | |
|---|---|---|---|---|
| 1 | 日付 | 部門 | 項目 | 金額 |
| 2 | 2026/04/01 | 営業部 | 会議費 | 12000 |
| 3 | 2026/04/15 | 製造部 | 材料費 | 45000 |
4月分だけが別シートに自動抽出。件数表示付きで確認もラク。
どんな場面で使う？
- 品質管理: 検査データから不良カテゴリ別に抽出して月次品質レポートを作る
- 経理: 売上データを部門別・期間別に抽出して月次報告シートにまとめる
- 営業: 顧客リストから地域＋ランクで絞り込んでDMリストを作る
- どんな職種でも: 「毎月同じフィルター条件でデータを抽出して別シートにまとめている」なら、この自動化が使える
なお、特定の文字を「検索してハイライトする」のは 特定の文字を含むセルを検索してハイライト を参照。この記事では「条件で行を抽出して別シートにまとめる」に特化する。抽出後のデータに重複がある場合は 重複データを一括削除して一意のリストを作る も参考にしてほしい。
実行前の準備
シート構成を確認する
このコードは以下の2シート構成を前提としている：
「データ」シート（元データ）:
| A列 | B列 | C列 | D列 |
|---|---|---|---|
| 日付 | カテゴリ | 品名 | 金額 |
| 2026/03/01 | 原材料 | 鋼材A | 50000 |
| 2026/03/05 | 外注費 | 加工B | 30000 |
- 1行目はヘッダー
- 2行目以降がデータ
「抽出結果」シート:
- 抽出結果の貼り付け先。マクロ実行時にクリアしてから貼り付ける
バックアップを取る
抽出先シートの既存データは上書きされる。元データは変更されないが、念のためファイルのコピーを保存しておく。
コード（最小版）– 1条件でフィルター＋別シートにコピー
'============================================================
' ■ AutoFilterで条件抽出 → 別シートにコピー（最小版）
' → 指定列の条件に一致するデータを抽出し、別シートに貼り付け
'============================================================
Sub FilterAndCopyMinimal()
'--- ★書き換えポイント ---
Dim srcSheet As String
srcSheet = "データ" '← 元データのシート名
Dim destSheet As String
destSheet = "抽出結果" '← 抽出結果の貼り付け先シート名
Dim filterCol As Long
filterCol = 2 '← フィルターする列番号（2=B列）
Dim filterValue As String
filterValue = "原材料" '← 抽出条件（完全一致）
'--- ★ここまで ---
Dim wsSrc As Worksheet
Set wsSrc = ThisWorkbook.Worksheets(srcSheet)
Dim wsDest As Worksheet
Set wsDest = ThisWorkbook.Worksheets(destSheet)
'--- 抽出先シートをクリア
wsDest.Cells.Clear
'--- 既存のAutoFilterを解除
If wsSrc.AutoFilterMode Then wsSrc.AutoFilterMode = False
'--- AutoFilter実行
Dim lastRow As Long
lastRow = wsSrc.Cells(wsSrc.Rows.Count, 1).End(xlUp).Row
Dim dataRange As Range
Set dataRange = wsSrc.Range("A1:D" & lastRow)
dataRange.AutoFilter Field:=filterCol, Criteria1:=filterValue
'--- 抽出結果を別シートにコピー
Dim visibleCount As Long
On Error Resume Next
visibleCount = dataRange.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
On Error GoTo 0
If visibleCount > 0 Then
dataRange.SpecialCells(xlCellTypeVisible).Copy
wsDest.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
'--- フィルター解除
wsSrc.AutoFilterMode = False
'--- 完了メッセージ
If visibleCount > 0 Then
MsgBox visibleCount & " 件のデータを抽出しました。" & vbCrLf & _
"結果: " & destSheet & "シート", vbInformation
Else
MsgBox "条件に一致するデータがありませんでした。", vbExclamation
End If
End Sub
書き換えポイント
| 変数 | 説明 | 初期値 |
|---|---|---|
srcSheet |
元データのシート名 | "データ" |
destSheet |
抽出結果の貼り付け先 | "抽出結果" |
filterCol |
フィルターする列番号 | 2（B列） |
filterValue |
抽出条件 | "原材料" |
コードの流れ
- 抽出先シートをクリア（前回の結果を消す）
- 既存のAutoFilterを解除（二重設定防止）
- データ範囲に
AutoFilterを実行 SpecialCells(xlCellTypeVisible)でフィルター結果（可視セル）を取得- 抽出結果を別シートにコピー（値のみ）
- フィルターを解除して元に戻す
重要: フィルター結果が0件の場合、SpecialCells がエラーになる。On Error Resume Next で回避し、0件チェックを行っている。転記の技術は セルの転記を自動化する方法 と同じ仕組み。
コード（実務版）– 複数条件＋日付範囲＋件数表示
実務では「カテゴリがAまたはB」かつ「日付が今月分」のように複数条件を組み合わせる。日付範囲のフィルターと、OR条件の指定方法を追加した版。
日付範囲の絞り込みを追加してからは、月次報告書の抽出が正確になった。先月分と今月分を間違えて報告する事故がなくなった。条件を変数で管理しているので、来月の報告でも変数を1行書き換えるだけで対応できる。
'============================================================
' ■ 複数条件AutoFilter＋日付範囲＋別シートコピー（実務版）
' → カテゴリOR条件 ＋ 日付範囲AND条件
'============================================================
Sub FilterAndCopyAdvanced()
'--- ★書き換えポイント ---
Dim srcSheet As String
srcSheet = "データ"
Dim destSheet As String
destSheet = "抽出結果"
'--- フィルター条件1: カテゴリ（B列）のOR条件
Dim categoryCol As Long
categoryCol = 2 '← カテゴリ列（B列）
Dim categories As Variant
categories = Array("原材料", "外注費") '← 抽出するカテゴリ（複数可）
'--- フィルター条件2: 日付範囲（A列）
Dim dateCol As Long
dateCol = 1 '← 日付列（A列）
Dim startDate As Date
startDate = DateSerial(Year(Date), Month(Date), 1) '← 今月1日
Dim endDate As Date
endDate = DateSerial(Year(Date), Month(Date) + 1, 0) '← 今月末日
'--- ★ここまで ---
Dim wsSrc As Worksheet
Set wsSrc = ThisWorkbook.Worksheets(srcSheet)
Dim wsDest As Worksheet
Set wsDest = ThisWorkbook.Worksheets(destSheet)
'--- 抽出先シートをクリア
wsDest.Cells.Clear
'--- 既存のAutoFilterを解除
If wsSrc.AutoFilterMode Then wsSrc.AutoFilterMode = False
'--- データ範囲を設定
Dim lastRow As Long
lastRow = wsSrc.Cells(wsSrc.Rows.Count, 1).End(xlUp).Row
Dim lastCol As Long
lastCol = wsSrc.Cells(1, wsSrc.Columns.Count).End(xlToLeft).Column
Dim dataRange As Range
Set dataRange = wsSrc.Range(wsSrc.Cells(1, 1), wsSrc.Cells(lastRow, lastCol))
'--- AutoFilter: カテゴリ（OR条件）
dataRange.AutoFilter Field:=categoryCol, _
Criteria1:=categories, _
Operator:=xlFilterValues
'--- AutoFilter: 日付範囲（AND条件）
dataRange.AutoFilter Field:=dateCol, _
Criteria1:=">=" & Format(startDate, "yyyy/MM/dd"), _
Operator:=xlAnd, _
Criteria2:="<=" & Format(endDate, "yyyy/MM/dd")
'--- 抽出結果を別シートにコピー
Dim visibleCount As Long
On Error Resume Next
visibleCount = dataRange.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
On Error GoTo 0
If visibleCount > 0 Then
dataRange.SpecialCells(xlCellTypeVisible).Copy
wsDest.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
'--- フィルター解除
wsSrc.AutoFilterMode = False
'--- 完了メッセージ
Dim msg As String
If visibleCount > 0 Then
msg = visibleCount & " 件のデータを抽出しました。" & vbCrLf & _
"条件: " & Join(categories, ", ") & vbCrLf & _
"期間: " & Format(startDate, "yyyy/MM/dd") & " 〜 " & _
Format(endDate, "yyyy/MM/dd") & vbCrLf & _
"結果: " & destSheet & "シート"
MsgBox msg, vbInformation
Else
MsgBox "条件に一致するデータがありませんでした。" & vbCrLf & _
"条件: " & Join(categories, ", ") & vbCrLf & _
"期間: " & Format(startDate, "yyyy/MM/dd") & " 〜 " & _
Format(endDate, "yyyy/MM/dd"), vbExclamation
End If
End Sub
書き換えポイント
| 変数 | 説明 | 初期値 |
|---|---|---|
srcSheet / destSheet |
元データ / 抽出先シート名 | "データ" / "抽出結果" |
categoryCol |
カテゴリ列の番号 | 2（B列） |
categories |
抽出するカテゴリ（複数指定可） | Array("原材料", "外注費") |
dateCol |
日付列の番号 | 1（A列） |
startDate / endDate |
日付範囲 | 今月1日〜今月末日 |
コードの流れ
- 抽出先クリア: 前回の結果を消す
- AutoFilter解除: 二重設定を防止
- カテゴリOR条件:
Operator:=xlFilterValues+Array()で複数値を指定 - 日付AND条件:
>=開始日AND<=終了日で範囲指定 - 可視セルコピー:
SpecialCells(xlCellTypeVisible)で抽出結果を取得 - フィルター解除: 元データを元の状態に戻す
- 件数表示: 抽出件数・条件・期間をまとめて表示
抽出マクロをボタン（マクロをボタン1つで実行する方法）に割り当てれば、毎月の報告書作成がボタン1つで完了する。
よくある落とし穴5選
1. フィルター結果が0件で「SpecialCells」エラー
自分もこれで止まった。条件に一致するデータが0件のときに SpecialCells(xlCellTypeVisible) がエラーを出す。「データがないだけなのに止まるの？」と最初は戸惑った。
対策: On Error Resume Next で一旦エラーを無視し、可視セル数をカウントして0件チェックを行う。コード内で対策済み。
2. AutoFilterが二重にかかってエラー
原因: 既にAutoFilterがかかっている状態で AutoFilter を実行すると、意図しない動作になる。
対策: If wsSrc.AutoFilterMode Then wsSrc.AutoFilterMode = False で事前に解除。コード内で対策済み。
3. 日付のフィルターが効かない
原因: セルの書式が「文字列」になっていると、日付として認識されない。
自分もこれに気づくのに時間がかかった。日付に見えるのに抽出結果が0件。調べたらセルの書式が「文字列」で、Excelが日付として認識していなかった。データを入力し直すか、CDate で変換する必要がある。
対策: 日付列のセル書式を「日付」に変更する。Format(startDate, "yyyy/MM/dd") の形式がシートの日付形式と一致しているか確認する。
4. 抽出先シートの既存データが残っている
原因: 前回の抽出結果が残ったままで、新しい結果と混在する。
対策: コード冒頭で wsDest.Cells.Clear を実行して全クリアしている。
5. ワイルドカードの意図しないマッチ
原因: Criteria1:="材*" のように * を使うと、「材料」「材質」「材木」すべてにマッチする。
対策: 完全一致で抽出したい場合は * を使わない。部分一致なら "*材*" のように両側に付ける。
VBAのAutoFilterで抽出結果が0件になるときの対処法
「条件に合うデータがあるはずなのに抽出結果が空になる」という場合、原因はフィルター対象の列番号がずれていることだ。AutoFilter Field:=2 の数値はデータ範囲内の相対的な列番号であり、シートの列番号とは異なる場合がある。データ範囲の何列目を対象にしているかを確認すれば解決する。
VBAで抽出結果を別シートにコピーできないときの対処法
「SpecialCellsでエラーが出る」という場合、原因はフィルター後の表示行が0件（ヘッダーのみ）であることだ。SpecialCells(xlCellTypeVisible) は表示行がない場合にエラーになる。コピー前に Application.WorksheetFunction.Subtotal(103, 対象列) で表示行数をチェックし、0件ならスキップする分岐を入れれば安全に動作する。
実務で抽出条件を決めるときの注意点
フィルター抽出は、一覧から対象者、対象月、未処理データだけを取り出すときに便利です。ただし、抽出条件があいまいなままだと、必要なデータが漏れたり、関係ない行まで混ざったりします。実務では、抽出条件をコードに直接書く前に、どの列を基準にするか、部分一致か完全一致か、日付の範囲を含むかを表にして確認すると失敗が減ります。
抽出先シートの扱いも重要です。前回の抽出結果が残ったままだと、今回の結果と混ざって誤解を生みます。毎回クリアしてから貼り付ける、抽出日時を残す、0件だった場合は見出しだけ残してメッセージを出すなど、結果の見え方まで決めておくと実務で使いやすくなります。
| 確認項目 | 起きやすい問題 | 対策 |
|---|---|---|
| 一致条件 | 部分一致で余計なデータを拾う | 完全一致/部分一致を先に決める |
| 日付条件 | 文字列扱いで範囲指定が効かない | 日付列の形式をそろえる |
| 抽出先 | 前回結果が残る | 貼り付け前に結果範囲をクリアする |
| 0件時 | SpecialCellsでエラーになる | 件数確認してからコピーする |
抽出条件を確認してから実行する例
Dim criteriaName As String
criteriaName = Trim(Range("B2").Value)
If criteriaName = "" Then
MsgBox "抽出条件を入力してください。"
Exit Sub
End If
If MsgBox("条件: " & criteriaName & " で抽出します。", vbYesNo) <> vbYes Then
Exit Sub
End If抽出処理は、使う人から見ると一瞬で結果が出るため、条件の間違いに気づきにくい処理です。抽出前に条件を表示し、抽出後に件数を表示するだけでも、業務上の確認ポイントがはっきりします。
FAQ
Q1: 3列以上に条件を設定したい
AutoFilter を列ごとに複数回実行する。条件は上書きではなくANDで積み重なる：
dataRange.AutoFilter Field:=1, Criteria1:=">=2026/03/01" '← A列
dataRange.AutoFilter Field:=2, Criteria1:="原材料" '← B列
dataRange.AutoFilter Field:=4, Criteria1:=">=10000" '← D列
Q2: フィルターだけかけて、コピーはしない
別シートコピーの処理を削除し、フィルターだけ残す。手動で確認してからコピーしたい場合に便利。
Q3: 書式もコピーしたい
xlPasteValues を xlPasteAll に変更する：
wsDest.Range("A1").PasteSpecial xlPasteAll
Q4: 抽出結果をPDFで保存したい
抽出結果シートをPDFに変換できる。ExcelファイルをPDFに一括変換 を参照。
Q5: 抽出結果をCSVで出力したい
抽出結果シートをCSVに書き出せる。ExcelデータをCSVファイルに書き出す を参照。
まとめ
AutoFilterで条件指定してデータを抽出できる（最小版）xlFilterValues+Array()で複数条件のOR抽出ができる（実務版）- 日付範囲は
>=/<=のAND条件で指定する - 0件チェック（
SpecialCellsのエラー回避）を忘れずに入れる
関連記事
- 重複データを一括削除して一意のリストを作る — 抽出後に重複を除去
- セルの値に応じて行を自動色分け — 抽出結果をカテゴリ別に色分け
- マクロをボタン1つで実行する方法 — 抽出マクロをボタンに割り当て
次にやりたくなること
- 特定の文字を含むセルを検索してハイライト: 抽出ではなく「ハイライト」で目立たせたいときに。元データを残したまま該当箇所を可視化
- 重複データを一括削除して一意のリストを作る: 抽出結果に重複があるとき、一意のリストにクリーンアップ
- ExcelデータをCSVファイルに書き出す: 抽出結果をCSVで外部システムに連携。月次データの受け渡しに便利
コメント