Excelで大量のデータを扱っていると、
「条件に合うデータだけを抽出して別のファイルにまとめたい」という場面は非常に多いです。
たとえば営業成績表から「東京支店」のデータだけを別ブックにまとめて送信したり、
商品マスターから特定カテゴリの商品だけを別ファイルに保存するなど、日常業務でよく使われます。
この記事では、VBAでフィルター抽出後のデータを別ブックに自動コピーする方法を、
実務に即したステップとサンプルコードでわかりやすく紹介します。
目次
✅ オートフィルタ＋別ブックコピーの基本構成
VBAでの流れはシンプルです。
- 元データをフィルターで抽出する
- 抽出結果（可視セル）を取得する
- 新しいブックまたは既存のブックを開く
- 抽出結果を貼り付ける
この流れを自動化することで、「抽出→コピー→保存」まで一括で完了します。
✅ 基本構文：抽出結果を新しいブックにコピーする
まずは最も基本的な例です。
A列を基準に「営業部」のデータだけを抽出し、新しいブックに転記して保存します。
Sub FilterToNewWorkbook()
Dim wsSrc As Worksheet
Dim rng As Range, visibleRange As Range
Dim newBook As Workbook
Dim savePath As String
Set wsSrc = ThisWorkbook.Sheets("データ")
savePath = ThisWorkbook.Path & "\営業部データ_" & Format(Date, "yyyymmdd") & ".xlsx"
'--- フィルタ設定 ---
wsSrc.Range("A1").AutoFilter Field:=1, Criteria1:="営業部"
Set rng = wsSrc.AutoFilter.Range
'--- フィルタ結果を取得 ---
On Error Resume Next
Set visibleRange = rng.Offset(1, 0).Resize(rng.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If visibleRange Is Nothing Then
MsgBox "該当データがありません。", vbInformation
wsSrc.AutoFilterMode = False
Exit Sub
End If
'--- 新しいブックを作成 ---
Set newBook = Workbooks.Add
rng.Rows(1).Copy newBook.Sheets(1).Range("A1") 'ヘッダー
visibleRange.Copy newBook.Sheets(1).Range("A2")
'--- ファイル保存 ---
Application.DisplayAlerts = False
newBook.SaveAs Filename:=savePath
newBook.Close
Application.DisplayAlerts = True
wsSrc.AutoFilterMode = False
MsgBox "営業部データを別ブックに出力しました。", vbInformation
End Sub
コードのポイント
AutoFilterで条件抽出SpecialCells(xlCellTypeVisible)で可視セルを取得
参考：【VBA】条件に一致するセルを取得する方法｜Find・For Each・SpecialCellsWorkbooks.Addで新しいブックを作成
参考：【VBA】フィルター結果を新しいbookに保存する方法- ヘッダー行（1行目）＋抽出結果を別ブックにコピー
SaveAsで自動保存（ファイル名に日付を付与）
参考：【VBA】Application.GetSaveAsFilenameメソッドを使用する方法
これだけで、フィルタ結果を別ブックに安全に出力できます。
✅ 応用①：既存ブックへコピーする
「毎回新しいブックを作るのではなく、既にある集計用ブックに貼り付けたい」
そんなときは、既存ブックを開いて貼り付ける構文に変えます。
Sub FilterToExistingWorkbook()
Dim wsSrc As Worksheet
Dim rng As Range, visibleRange As Range
Dim wbDst As Workbook
Dim wsDst As Worksheet
Dim dstPath As String
Set wsSrc = ThisWorkbook.Sheets("データ")
dstPath = ThisWorkbook.Path & "\集計ブック.xlsx"
'--- フィルタ設定 ---
wsSrc.Range("A1").AutoFilter Field:=2, Criteria1:="東京支店"
Set rng = wsSrc.AutoFilter.Range
On Error Resume Next
Set visibleRange = rng.Offset(1, 0).Resize(rng.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If visibleRange Is Nothing Then
MsgBox "東京支店のデータがありません。", vbInformation
wsSrc.AutoFilterMode = False
Exit Sub
End If
'--- 既存ブックを開く ---
Set wbDst = Workbooks.Open(dstPath)
Set wsDst = wbDst.Sheets("抽出結果")
wsDst.Cells.ClearContents
rng.Rows(1).Copy wsDst.Range("A1") 'ヘッダー
visibleRange.Copy wsDst.Range("A2")
wbDst.Save
wbDst.Close
wsSrc.AutoFilterMode = False
MsgBox "東京支店データを既存ブックに転記しました。", vbInformation
End Sub
✅ メリット
- 集計用ブックを定期更新できる
- 既存フォーマット（数式や書式）を維持したまま転記可能
参考：【VBA】ブックを指定してシートを追加する方法
⚠️ 注意
- 転記先ブックが開かれていない場合は自動で開く処理が必要
- シート名の誤りに注意（存在しない場合エラーになります）
✅ 応用②：複数条件を順に抽出して別ブックに出力
「部門別に自動で別ファイルを作成したい」というケースも多いでしょう。
次のようにループを使えば、一度に複数のファイルを出力できます。
Sub ExportByDepartment()
Dim ws As Worksheet
Dim rng As Range, visibleRange As Range
Dim depList As Variant, dep As Variant
Dim newBook As Workbook
Dim savePath As String
Set ws = Sheets("データ")
depList = Array("営業部", "開発部", "総務部")
For Each dep In depList
ws.Range("A1").AutoFilter Field:=1, Criteria1:=dep
Set rng = ws.AutoFilter.Range
On Error Resume Next
Set visibleRange = rng.Offset(1, 0).Resize(rng.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not visibleRange Is Nothing Then
Set newBook = Workbooks.Add
rng.Rows(1).Copy newBook.Sheets(1).Range("A1")
visibleRange.Copy newBook.Sheets(1).Range("A2")
savePath = ThisWorkbook.Path & "\" & dep & "_抽出_" & Format(Date, "yyyymmdd") & ".xlsx"
newBook.SaveAs Filename:=savePath
newBook.Close
End If
Next dep
ws.AutoFilterMode = False
MsgBox "全部署の抽出ファイルを出力しました。", vbInformation
End Sub
このようにすれば、1回の実行で
「営業部.xlsx」「開発部.xlsx」「総務部.xlsx」などが自動で生成されます。
各部門へ共有する作業を大幅に短縮できます。
参考：【VBA】For Each ステートメントの使い方と活用例
✅ 応用③：コピー先を選択できるようにする（ダイアログ利用）
ユーザーが保存先を自由に選びたい場合は、
Application.GetSaveAsFilename を使うと便利です。
Sub FilterToUserSelectedFile()
Dim ws As Worksheet
Dim rng As Range, visibleRange As Range
Dim newBook As Workbook
Dim saveFile As Variant
Set ws = Sheets("データ")
ws.Range("A1").AutoFilter Field:=3, Criteria1:="未完了"
Set rng = ws.AutoFilter.Range
On Error Resume Next
Set visibleRange = rng.Offset(1).Resize(rng.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If visibleRange Is Nothing Then
MsgBox "該当データがありません。", vbInformation
ws.AutoFilterMode = False
Exit Sub
End If
saveFile = Application.GetSaveAsFilename( _
InitialFileName:="未完了リスト_" & Format(Date, "yyyymmdd") & ".xlsx", _
FileFilter:="Excelファイル (*.xlsx), *.xlsx")
If saveFile = False Then Exit Sub
Set newBook = Workbooks.Add
rng.Rows(1).Copy newBook.Sheets(1).Range("A1")
visibleRange.Copy newBook.Sheets(1).Range("A2")
newBook.SaveAs Filename:=saveFile
newBook.Close
ws.AutoFilterMode = False
MsgBox "データを選択した場所に保存しました。", vbInformation
End Sub
これにより、ファイル保存先をユーザーが自由に選べます。
社内共有フォルダやUSBなど、用途に応じて柔軟に対応できます。
参考：【VBA】Application.GetSaveAsFilenameメソッドを使用する方法
✅ フィルタ結果コピーの安定化テクニック
・1. フィルタ解除を忘れない
AutoFilterMode = False を最後に入れておかないと、
次回の実行時に範囲指定がずれて正しく動作しません。
・2. 可視セルがない場合の判定を必ず入れる
visibleRange Is Nothing のチェックを入れることで、
「0件時にエラーで止まる」問題を防げます。
・3. Application.DisplayAlerts = False の使い方
自動保存処理では、上書き確認を出さないように一時的に警告を無効化します。
ただし、保存完了後に Trueに戻す のを忘れないようにしましょう。
参考：【VBA】プロパティとメソッド一覧｜違い・使い方・実務で覚える操作まとめ
✅ 実務応用：毎日自動で抽出してフォルダに出力
売上データなどを「毎朝自動で条件抽出して別ブック出力」する仕組みにも応用できます。
UiPathなどのRPAツールと組み合わせれば、完全自動レポートも実現可能です。
Sub DailyAutoExport()
Dim ws As Worksheet
Dim rng As Range, visibleRange As Range
Dim newBook As Workbook
Dim folderPath As String
folderPath = "C:\Reports\" & Format(Date, "yyyymmdd")
MkDir folderPath
Set ws = Sheets("売上データ")
ws.Range("A1").AutoFilter Field:=5, Criteria1:=">100000"
Set rng = ws.AutoFilter.Range
On Error Resume Next
Set visibleRange = rng.Offset(1).Resize(rng.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not visibleRange Is Nothing Then
Set newBook = Workbooks.Add
rng.Rows(1).Copy newBook.Sheets(1).Range("A1")
visibleRange.Copy newBook.Sheets(1).Range("A2")
newBook.SaveAs folderPath & "\高売上レポート.xlsx"
newBook.Close
End If
ws.AutoFilterMode = False
End Sub
フォルダ名に日付を付けて保存することで、日次レポートを自動でアーカイブできます。
RPAやWindowsタスクスケジューラと連携させれば、完全無人運用も可能です。
参考：【RPA入門】UiPathでできること一覧｜Excel・メール・ブラウザ操作を徹底解説
✅ まとめ：フィルター結果を別ブックに出力して業務を効率化
AutoFilterで条件抽出し、SpecialCellsで可視セルを取得- 新しいブック (
Workbooks.Add) または既存ブック (Workbooks.Open) に転記 SaveAsで日付付きファイル名を自動保存- 複数条件をループすれば「部署別」「カテゴリ別」など一括出力が可能
- 0件時のエラー回避・フィルタ解除は必ず実装
オートフィルタとVBAを組み合わせることで、
手作業で数十分かかる「抽出→転記→保存」の工程を数秒で自動化できます。
データ処理の効率化やレポート業務の自動化に、
ぜひこの「フィルター結果を別ブックへ出力するVBA」を取り入れてみてください。