VBAで自動化 VBA一覧 フィルター結果のコピー・抽出 抽出・検索処理

【VBA】マクロでフィルター抽出したデータを別シートに自動転記する方法｜効率的なデータ整理術

Excelを使ってデータを分析していると、「特定の条件に合う行だけを別シートに抜き出したい」という場面がよくあります。
たとえば「営業担当ごとの売上を個別シートにまとめたい」「在庫ありの商品だけを一覧にしたい」「特定の支店データを抽出して報告書を作成したい」などです。

このような作業を手作業で行うと、毎回フィルターを設定してコピーペーストを繰り返す必要があります。
しかし、VBAマクロを使えば、ボタン1つで自動的にフィルター抽出と転記を実行できるようになります。

この記事では、Excel VBAで「フィルター抽出したデータを別シートに出力する方法」を、基本から応用まで詳しく解説します。
実務にすぐ使えるコード例も交えて紹介します。

✅ フィルター抽出して別シートにコピーする基本構文

まずは最も基本的な「特定条件でフィルターをかけて、抽出結果を別シートにコピーする」マクロを紹介します。
今回は「売上金額が100000以上のデータだけを別シートに出力」する例を用います。

・基本構文

Sub FilterAndCopyToSheet()
    Dim wsSrc As Worksheet
    Dim wsDst As Worksheet
    Dim rngVisible As Range
    
    'シートを設定
    Set wsSrc = Worksheets("売上データ")
    Set wsDst = Worksheets("抽出結果")
    
    '既存のフィルタを解除
    wsSrc.AutoFilterMode = False
    
    'フィルタ適用（売上金額が10万円以上）
    wsSrc.Range("A1").CurrentRegion.AutoFilter Field:=3, Criteria1:=">=100000"
    
    '抽出結果（可視セル）の取得
    On Error Resume Next
    Set rngVisible = wsSrc.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    'データが存在する場合のみコピー
    If Not rngVisible Is Nothing Then
        wsDst.Cells.Clear
        rngVisible.Copy Destination:=wsDst.Range("A1")
    Else
        MsgBox "該当データがありません。", vbInformation
    End If
    
    'フィルタ解除
    wsSrc.AutoFilterMode = False
End Sub

・処理の流れ

  1. 元データシート（売上データ）と転記先シート（抽出結果）を設定
  2. 既存フィルタを解除してリセット
  3. AutoFilterで条件指定（Field:=3はC列）
  4. SpecialCells(xlCellTypeVisible)で「表示中セル（抽出結果）」を取得
  5. 別シートへコピー

この基本構文を覚えるだけで、さまざまな条件抽出に応用可能です。

✅ フィルター抽出して「ヘッダーを除外」して転記する方法

多くの場合、抽出結果を別シートに貼り付けるとき、ヘッダー（項目名）を除きたいことがあります。
見出しを省いた状態で別シートに転記するには、OffsetとResizeを利用します。

・ヘッダーを除外してコピーする例

Sub FilterAndCopyWithoutHeader()
    Dim wsSrc As Worksheet
    Dim wsDst As Worksheet
    Dim rngVisible As Range
    
    Set wsSrc = Worksheets("売上データ")
    Set wsDst = Worksheets("抽出結果")
    
    wsSrc.AutoFilterMode = False
    wsSrc.Range("A1").CurrentRegion.AutoFilter Field:=3, Criteria1:=">=100000"
    
    On Error Resume Next
    Set rngVisible = wsSrc.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    If Not rngVisible Is Nothing Then
        '1行目をスキップ（ヘッダー除外）
        rngVisible.Offset(1, 0).Resize(rngVisible.Rows.Count - 1).Copy Destination:=wsDst.Range("A1")
    Else
        MsgBox "該当データがありません。", vbInformation
    End If
    
    wsSrc.AutoFilterMode = False
End Sub

・Offsetを使う理由

Offset(1,0)で範囲を1行下にずらし、Resizeで1行分減らすことで、ヘッダーを除外して実データだけをコピーできます。
レポート用の出力や集計用データを作成する際に重宝します。

参考：【VBA】範囲指定の使い方：Offsetプロパティ

✅ フィルター条件を変数で指定して汎用化する

業務で同じ処理を複数条件で繰り返す場合、条件を変数化して使い回せるようにしておくと便利です。
たとえば「担当者名」や「支店名」を入力ボックスで指定して抽出するマクロです。

・担当者名でフィルター抽出する例

Sub FilterByNameAndCopy()
    Dim wsSrc As Worksheet
    Dim wsDst As Worksheet
    Dim empName As String
    Dim rngVisible As Range
    
    Set wsSrc = Worksheets("売上データ")
    Set wsDst = Worksheets("抽出結果")
    
    '条件をユーザー入力
    empName = InputBox("抽出する担当者名を入力してください。", "担当者別抽出")
    If empName = "" Then Exit Sub
    
    wsSrc.AutoFilterMode = False
    wsSrc.Range("A1").CurrentRegion.AutoFilter Field:=2, Criteria1:=empName
    
    On Error Resume Next
    Set rngVisible = wsSrc.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    If Not rngVisible Is Nothing Then
        wsDst.Cells.Clear
        rngVisible.Copy Destination:=wsDst.Range("A1")
        MsgBox empName & " さんのデータを転記しました。", vbInformation
    Else
        MsgBox "該当データがありません。", vbInformation
    End If
    
    wsSrc.AutoFilterMode = False
End Sub

・この方法の利点

  • 入力に応じてフィルター条件を動的に変更できる
  • 同じコードで複数の抽出パターンに対応可能
  • UI要素（InputBox）で初心者でも使いやすい
    参考：【VBA】InputBoxの活用方法

✅ 複数条件で抽出して別シートへコピーする

Excelでは1つの列だけでなく、「複数条件を組み合わせて抽出」することもよくあります。
たとえば「支店＝東京 かつ 売上金額≥100000」のような場合です。

・複数条件で抽出するVBA

Sub FilterByMultipleConditions()
    Dim wsSrc As Worksheet
    Dim wsDst As Worksheet
    Dim rngVisible As Range
    
    Set wsSrc = Worksheets("売上データ")
    Set wsDst = Worksheets("抽出結果")
    
    wsSrc.AutoFilterMode = False
    
    With wsSrc.Range("A1").CurrentRegion
        .AutoFilter Field:=1, Criteria1:="東京"
        .AutoFilter Field:=3, Criteria1:=">=100000"
    End With
    
    On Error Resume Next
    Set rngVisible = wsSrc.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    If Not rngVisible Is Nothing Then
        wsDst.Cells.Clear
        rngVisible.Copy Destination:=wsDst.Range("A1")
        MsgBox "条件に一致するデータを転記しました。", vbInformation
    Else
        MsgBox "該当データがありません。", vbInformation
    End If
    
    wsSrc.AutoFilterMode = False
End Sub

・ポイント

✅ 複数シートへ自動的に振り分ける応用マクロ

より高度な応用として、「担当者ごとにシートを自動作成して抽出データをそれぞれ貼り付ける」方法があります。
これは、営業成績や地域別リストなどの自動レポート出力に非常に便利です。

・担当者ごとにシートを自動作成するVBA

Sub SplitDataByStaff()
    Dim wsSrc As Worksheet
    Dim rng As Range
    Dim c As Range
    Dim staffName As String
    Dim wsNew As Worksheet
    
    Set wsSrc = Worksheets("売上データ")
    wsSrc.AutoFilterMode = False
    
    '担当者列のデータ範囲を取得（2列目が担当者）
    Set rng = wsSrc.Range("B2:B" & wsSrc.Cells(wsSrc.Rows.Count, "B").End(xlUp).Row)
    
    '重複なしリストを作成
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    For Each c In rng
        If Not dict.exists(c.Value) And c.Value <> "" Then
            dict.Add c.Value, Nothing
        End If
    Next c
    
    '各担当者ごとに抽出＆シート出力
    For Each staffName In dict.keys
        wsSrc.AutoFilterMode = False
        wsSrc.Range("A1").CurrentRegion.AutoFilter Field:=2, Criteria1:=staffName
        
        'シート作成（存在する場合はクリア）
        On Error Resume Next
        Set wsNew = Worksheets(staffName)
        On Error GoTo 0
        If wsNew Is Nothing Then
            Set wsNew = Worksheets.Add
            wsNew.Name = staffName
        Else
            wsNew.Cells.Clear
        End If
        
        'コピーして貼り付け
        wsSrc.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy Destination:=wsNew.Range("A1")
    Next staffName
    
    wsSrc.AutoFilterMode = False
    MsgBox "担当者ごとのシート作成が完了しました。", vbInformation
End Sub

・実務での活用イメージ

  • 各営業担当ごとの成果を個別シートに分けて出力
  • 部署別・支店別の月報を一括生成
  • 自動レポート作成ツールの一部として活用

このような自動化により、毎月数時間かかっていた仕分け作業を数秒で終わらせることができます。

✅ トラブル防止のためのチェックポイント

オートフィルタ＋コピー処理を安全に運用するには、次の注意点を押さえておくことが重要です。

・可視セルがないとエラーが出る

SpecialCells(xlCellTypeVisible)は、データがない場合エラーを返します。
必ずOn Error Resume NextとNothing判定を入れましょう。

・フィルタ解除を忘れない

処理が終わった後にAutoFilterMode = Falseを実行しておかないと、
次のマクロ実行時に条件が残って誤動作することがあります。

・同名シートの存在確認

シート自動作成時は、同名シートがすでに存在している可能性があるため、
On Error Resume Nextを使ってエラー回避することが大切です。

✅ まとめ：マクロでフィルター抽出→別シート転記を自動化しよう

最後に、本記事のポイントを整理します。

  • AutoFilterを使うと特定条件で簡単にデータ抽出ができる
  • SpecialCells(xlCellTypeVisible)で抽出データのみを取得
  • OffsetとResizeでヘッダーを除外可能
  • 入力ボックスや複数条件を使えば柔軟な抽出が可能
  • 担当者や支店ごとにシート自動分割もできる

マクロでフィルター抽出から別シート転記まで自動化すれば、
日次・月次報告や部署別分析の効率が飛躍的に向上します。
一度マクロを作っておけば、ボタンひとつで定型処理を完了できるため、
手作業のコピーミスもなくなり、作業スピードと正確性の両方を実現できます。

-VBAで自動化, VBA一覧, フィルター結果のコピー・抽出, 抽出・検索処理