EXCEL VBA オートフィルタでデータの抽出・絞り込んだデータを別のセルに転記・別シートに結果をコピーする（AutoFilter）テクニック

●はじめに

今回説明するのは、オートフィルター機能を使い、絞り込んだ結果を別のシートに転記や別のセルにコピーする方法を説明いたします。オートフィルターは、とても便利で様々な条件を設定をする事で、簡単にデータを抽出してくれます。指定した条件で抽出したデータを残したい場合があると思いますが、今回のサンプルプログラムでは、このオートフィルターの抽出結果を残す方法を説明いたします。別のシートに残す方法と別のセルに残す方法の２通りの説明をサンプルプログラムを交えて順番に説明いたします。

●【EXCEL VBA オートフィルタでデータの抽出・条件・設定方法　（AutoFilter）については、下記を参照して下さい】

●【EXCEL VBA オートフィルタでデータの抽出・日付で絞り込む・期間・年月・四半期（AutoFilter）については、下記を参照して下さい】

●【Range.AutoFilter メソッド (Excel)、下記を参照して下さい】（Microsoft社　様）】
https://learn.microsoft.com/ja-jp/office/vba/api/excel.range.autofilter

EXCEL VBA オートフィルタでデータの抽出・絞り込んだデータを同一シート内の別のセルに転記（コピー）する。

●プログラム説明（AutoFilter：抽出結果を転記①）

下記のサンプルプログラムは、オートフィルターの機能を使って抽出条件（C列：”男”）でデータを抽出して、抽出結果を隣のセル（H1）に転記（コピー）するサンプルプログラムです。今回のプログラムでは、簡単にデータを抽出し転記（コピー）する流れで作成していますので、プログラム的には汎用性がありません。1回目だけのプログラム実行だけで利用する場合は、有効な方法だと思います。

'
'
Sub AutofilterCurrentRegion00() 'オートフィルターを抽出し指定セルに転記

    With Range("A1")
        .AutoFilter Field:=3, Criteria1:="男"  'オートフィルターの抽出条件をフィールド３（C列）の”男”を抽出
        .CurrentRegion.Copy Range("H1")  'オートフィルターの抽出結果をセル（H1）に転記
        .AutoFilter 'オートフィルターを解除
    End With

End Sub
'

●実行前～実行後　※プログラム実行後、C列に登録されている「性別」男：で抽出されたデータを同じシートのセル「H1」を起点に男性のデータが転記されました。
（画面クリックして拡大）

EXCEL VBA オートフィルタでデータの抽出・絞り込んだデータを同一シート内の別のセルに転記（コピー）する。

●プログラム説明　（AutoFilter：抽出結果を転記②）

'
'
Sub AutofilterCurrentRegion02() 'オートフィルターの抽出結果を指定したセルに結果を転記

    Dim ws01 As Worksheet
    
    Set ws01 = Worksheets("社員台帳")
    
    With ws01.Range("A1")
        .AutoFilter Field:=3, Criteria1:="男"  'オートフィルターの抽出条件をフィールド３（C列）の”男”を抽出
        
        If WorksheetFunction.Subtotal(3, ws01.Range("C:C")) > 1 Then
            Worksheets.Add
            .CurrentRegion.Copy ActiveSheet.Range("A1")       'オートフィルターの抽出結果を追加したシートに転記
            .AutoFilter 'オートフィルターを解除
        End If
    End With
    

End Sub
'

●実行前～実行後　※プログラム実行後、C列に登録されている「性別」男：で抽出されたデータが同じシートのセル「H1」を起点にデータが転記されました。
（画面クリックして拡大）

EXCEL VBA オートフィルタでデータの抽出結果ごとに別シートにデータを転記（コピー）する。

●プログラム説明　（AutoFilter：抽出結果を転記③）

下記のサンプルプログラムは、シート「社員台帳」の血液型毎に社員データを抽出して、血液型毎にシートを作成し、該当する血液型ごとに社員データが転記されるサンプルプログラムです。管理台帳などのデータをカテゴリ別にデータを分ける際に便利だと思います。今回のプログラムについては、何度も繰り返し実行できるように作成しております。

'
'
Sub AutofilterCurrentRegion03() '社員データを元にオートフィルターで血液型ごとデータ抽出し、血液型ごとにに該当するシートにデータを転記します。

    Dim ws01, ws As Worksheet
    Dim lRow, xRow, I As Long
    
    Application.DisplayAlerts = False '確認・警告メッセージを表示しない様に設定する。ワークシートを削除する際のアラートメッセージを非表示
    
    For Each ws In ThisWorkbook.Worksheets  'このブックのワークシートを全て繰り返す。
    
        If ws.Name Like "*@*" Then
            ws.Delete 'ワークシート名に"@"が有るシートを削除します。（過去データを削除）
        End If
    
    Next ws
    
    Application.DisplayAlerts = True '確認・警告メッセージを表示設定に戻す。（表示設定）

    Set ws01 = Worksheets("社員台帳")
    
    lRow = ws01.Cells(Rows.Count, "A").End(xlUp).Row 'シート「社員台帳」の最終行を取得します。
    
    Range("E1:E" & lRow).Copy Range("I1") 'シート「社員台帳」E列の血液型をI列に転記します。
    Range("I1").CurrentRegion.RemoveDuplicates 1, xlYes  'I列に転記したデータを一意のデータにする
    
    
    xRow = ws01.Cells(Rows.Count, "I").End(xlUp).Row 'シート「社員台帳」の最終行を取得します。
    
    For I = 2 To xRow
    
        Set ws = Worksheets.Add(After:=Sheets(Worksheets.Count)) '新規シートを追加します。（既存シートの最後に追加）
        ws.Name = "@" & ws01.Cells(I, "I") 'シート名変更します。　シート名は、＠＋血液型（I列）
        
        With ws01.Range("A1")
            .AutoFilter Field:=5, Criteria1:=ws01.Cells(I, "I")    'オートフィルターの抽出条件をフィールド５（E列）の各血液型を抽出
            .CurrentRegion.Copy ws.Range("A1")       'オートフィルターの抽出結果を個々に作成した血液型のシートにデータ転記
            .AutoFilter 'オートフィルターを解除
        End With
        
        ws.Columns("A:F").AutoFit '血液型ごと転記したワークシートの列幅を自動調整します。
                        
    Next I

End Sub
'

●実行前～実行後　※プログラム実行後、社員台帳に登録されている社員データに対して、血液型ごとに作成したシートに該当する社員データが転記されました。
（画面クリックして拡大）

最後まで、ご覧いただきまして誠に有難うございました。
また、VBAに関するテクニックや便利な手法などをこのサイトに掲載していきますので、定期的に参照していただけると幸いです。

AKIRA