【VBA】オートフィルタでの抽出結果を別のシートに貼り付ける

オートフィルタでの抽出結果を別のシートに貼り付けるVBAを紹介します。

エクセルの「オートフィルタの詳細設定」という機能をマクロ化したものです。

オートフィルタでの抽出結果を別のシートに貼り付けるVBA

Sub 抽出1()

Dim a As Long
Dim Data As Range

Sheets(“Sheet2”).Select
Range(Cells(4, 1), Cells(Rows.Count, 12)).Clear

With Worksheets(“Sheet1”)
    a = .Cells(Rows.Count, 1).End(xlUp).Row
    Set Data = Range(.Cells(1, 1), .Cells(a, 12))
End With

Data.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range(“A1:A2”), CopyToRange:=Range(“A4”), Unique:=False

End Sub

解説

Sheet1
A列～L列にデータ
1行目はタイトル

Sheet2
抽出したデータを貼り付けるシート
A1：抽出項目の見出し
A2：条件
A4：抽出したデータの貼り付け位置

Sheet2の4行目移行をクリア

Sheet1のデータ範囲を取得する

取得したデータ範囲内で、条件に当てはまるものをSheet2のA4に貼り付ける

重複したデータが不要の場合は、「Unique:=False」を「Ture」に変更

抽出1マクロの「抽出項目の見出し」と「条件」をSheet1のN1:N2に変更

Sub 抽出2()

Dim a As Long
Dim Data, Con As Range

Sheets(“Sheet2”).Select
Columns(“A:L”).Clear

With Worksheets(“Sheet1”)
    a = .Cells(Rows.Count, 1).End(xlUp).Row
    Set Data = Range(.Cells(1, 1), .Cells(a, 12))
    Set Con = .Range(“N1:N2”)
End With

Data.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Con, CopyToRange:=Range(“A1”), Unique:=False

End Sub