【VBA】オートフィルタ結果を「見出しを除いてコピー」する方法｜自動抽出の基本テクニック

Excelのオートフィルタは、条件に一致するデータだけを素早く抽出できる便利な機能です。
しかし、VBAで自動化する際によくある悩みが、「抽出したデータをコピーしたいけど、見出し行は除外したい」という点です。

単純にフィルタ結果をコピーすると、ヘッダーまで含まれてしまい、
転記先で同じ見出しが重複する、または余分な行が増えるといった問題が発生します。

この記事では、オートフィルタ結果から見出し行を除いてコピーするVBAの書き方を、基本から応用まで詳しく紹介します。

✅ フィルタ結果コピーで起こる代表的なトラブル

・① ヘッダー行までコピーされてしまう

VBAの .AutoFilter.Range.Copy をそのまま使うと、
抽出範囲全体（＝見出し＋データ）がコピーされてしまいます。

Range("A1").AutoFilter Field:=1, Criteria1:="営業部"
Range("A1").CurrentRegion.Copy Sheets("抽出結果").Range("A1")

このコードでは「営業部」のデータは抽出できますが、1行目の見出し行まで一緒にコピーされます。
複数回転記する場合は見出しが重複してしまい、処理が煩雑になります。

・② フィルタ結果が0件でもエラーが出る

条件によっては抽出結果が0件になることもあります。
この場合、SpecialCells(xlCellTypeVisible)を使うと「実行時エラー1004」が発生します。

参考：【VBA】RangeクラスのSelectメソッドが失敗しました:1004

✅ 基本構文：見出しを除いてコピーする最もシンプルな方法

Sub CopyFilteredDataWithoutHeader()
    Dim wsSrc As Worksheet, wsDst As Worksheet
    Dim rng As Range, visibleRange As Range

    Set wsSrc = ThisWorkbook.Sheets("データ")
    Set wsDst = ThisWorkbook.Sheets("抽出結果")
    wsDst.Cells.Clear

    ' --- フィルタ設定 ---
    wsSrc.Range("A1").AutoFilter Field:=1, Criteria1:="営業部"

    ' --- フィルタ後の範囲取得 ---
    Set rng = wsSrc.AutoFilter.Range

    ' --- 見出しを除く（1行下から取得） ---
    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
        visibleRange.Copy wsDst.Range("A1")
        MsgBox "見出しを除いてコピーが完了しました。", vbInformation
    Else
        MsgBox "該当データがありません。", vbExclamation
    End If

    wsSrc.AutoFilterMode = False
End Sub

コード解説

• rng.Offset(1, 0)
  ヘッダー行の1行下（＝実データ開始行）から範囲を指定します。
  参考：【VBA】範囲指定の使い方：Offsetプロパティ
• Resize(rng.Rows.Count - 1)
  1行分（見出し）を除外してサイズを調整します。
• SpecialCells(xlCellTypeVisible)
  フィルタ後の可視セルのみを対象とします。
  参考：【VBA】特定のセル（空白セル・数式セル・エラーセル）を見つけ出す：SpecialCells メソッド
• On Error Resume Next
  抽出結果が0件でもマクロが止まらないようにします。
  参考：【VBA】On Error Resume Nextでエラーを無視してエラーの制御

これにより、見出しを除いたフィルタ結果のみを安全にコピーできます。

✅ 応用①：転記先を自動で追記する

複数条件でフィルタを繰り返す場合、転記先を上書きせず追記したいことがあります。
その場合は、次のように末尾行を自動検出して貼り付け位置を指定します。

Sub CopyFilteredDataAppend()
    Dim wsSrc As Worksheet, wsDst As Worksheet
    Dim rng As Range, visibleRange As Range
    Dim nextRow As Long

    Set wsSrc = ThisWorkbook.Sheets("データ")
    Set wsDst = ThisWorkbook.Sheets("集計結果")

    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 Not visibleRange Is Nothing Then
        nextRow = wsDst.Cells(wsDst.Rows.Count, "A").End(xlUp).Row + 1
        visibleRange.Copy wsDst.Range("A" & nextRow)
    End If

    wsSrc.AutoFilterMode = False
End Sub

この方法なら、複数部門のデータを1つのシートに順番に追加していくことが可能です。
レポート作成などの自動化に特に便利です。

参考：【VBA】AutoFilterの複数条件を設定する方法｜AND・ORを自在に操る実務向け活用術

✅ 応用②：ヘッダーを最初の1回だけコピー

実務では、最初の抽出時にだけ見出しを含めてコピーし、
以降は見出しを除外してデータだけ追記したいケースもあります。
次のように制御できます。

Sub CopyWithHeaderOnce()
    Dim wsSrc As Worksheet, wsDst As Worksheet
    Dim rng As Range, visibleRange As Range
    Dim nextRow As Long

    Set wsSrc = Sheets("データ")
    Set wsDst = Sheets("抽出結果")

    wsSrc.Range("A1").AutoFilter Field:=1, Criteria1:="営業部"
    Set rng = wsSrc.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
        If wsDst.Range("A1").Value = "" Then
            rng.Rows(1).Copy wsDst.Range("A1") 'ヘッダー行を最初だけ
            visibleRange.Copy wsDst.Range("A2")
        Else
            nextRow = wsDst.Cells(Rows.Count, "A").End(xlUp).Row + 1
            visibleRange.Copy wsDst.Range("A" & nextRow)
        End If
    End If

    wsSrc.AutoFilterMode = False
End Sub
 参考：【VBA】フィルター結果が0件のときに安全に処理する方法｜エラーを出さずにスキップする

✅ 応用③：条件を変数やセルから動的に取得

条件を毎回手動で変える代わりに、セルの入力値を条件として利用すれば、
ユーザーが入力した内容で自動抽出できます。

Sub DynamicFilterCopy()
    Dim ws As Worksheet, wsOut As Worksheet
    Dim key As String, rng As Range, visibleRange As Range

    Set ws = Sheets("データ")
    Set wsOut = Sheets("結果")
    key = ws.Range("E1").Value '抽出条件をセルから取得

    ws.Range("A1").AutoFilter Field:=1, Criteria1:=key
    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
        wsOut.Cells.Clear
        visibleRange.Copy wsOut.Range("A1")
    Else
        MsgBox "該当データがありません。", vbInformation
    End If

    ws.AutoFilterMode = False
End Sub

これにより、条件を自由に切り替えられる柔軟なマクロを実現できます。

参考：【VBA】Application.Gotoメソッドとは：セル・範囲を移動

✅ エラーを防ぐための3つのポイント

① フィルタ範囲を明示的に指定する

Range("A1").CurrentRegion は便利ですが、空白行があると範囲が分断されます。
確実に範囲を指定するには次のようにします。

Set rng = ws.Range("A1:D1000")

② 可視セルがない場合を必ず判定

visibleRange Is Nothing の判定を入れないと、0件時にマクロが止まります。

③ フィルタ解除で次の処理へ影響を残さない

最後に ws.AutoFilterMode = False を入れておくことで、次の操作を安全に行えます。

✅ 実務活用例：部署別データを自動抽出＆別シートに出力

部署ごとに売上や進捗を集計するケースでは、
フィルタ条件をループさせてそれぞれ別シートにコピーすることも可能です。

Sub SplitByDepartment()
    Dim ws As Worksheet, dep As Variant, i As Long
    Dim rng As Range, visibleRange As Range

    Set ws = Sheets("データ")
    dep = Array("営業部", "開発部", "総務部")

    For i = LBound(dep) To UBound(dep)
        ws.Range("A1").AutoFilter Field:=1, Criteria1:=dep(i)
        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
            Sheets(dep(i)).Cells.Clear
            rng.Rows(1).Copy Sheets(dep(i)).Range("A1")
            visibleRange.Copy Sheets(dep(i)).Range("A2")
        End If
    Next i

    ws.AutoFilterMode = False
End Sub

このコードで、部署ごとに自動でデータを抽出・分割出力できます。
営業報告書や部門別集計にそのまま応用可能です。

✅ まとめ：オートフィルタ＋見出し除外コピーで業務を自動化

• .AutoFilter.Range.Offset(1) で見出しを除外してコピー
• SpecialCells(xlCellTypeVisible) で可視セルのみ取得
• 0件時のエラー対策には If visibleRange Is Nothing
• 初回だけヘッダーをコピーすることで追記処理も可能
• 部署別・条件別の抽出にも柔軟に応用できる

オートフィルタはVBAの中でも特に汎用性が高い機能です。
「見出しを除いてコピー」する仕組みを取り入れれば、
報告書作成やデータ整理を手作業から完全自動化できます。