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

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

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

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

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

End Sub
'

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

'
'
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
'

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

'
'
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
'