【エクセル・マクロ・VBA】別シートに項目を準備_抽出して転記

アドバンスフィルタ／別シートに項目を準備_抽出して転記１

アドバンスフィルタ（AdvancedFilter）を使用して、別シートに準備された項目を使ってデータを抽出し、指定されたシートに転記するものです。

検索条件シート／転記先シート準備
⇒CriteriaRange→検索条件／CopyToRange→転記先

Sub アドバンスフィルタ_別シートに項目を準備_抽出して転記1()

Dim LastRow1 As Long
LastRow1 = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row               
Dim LastCol1 As Long
LastCol1 = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column    

Selection.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Worksheets("検索条件").Range("A2:J2"), _
CopyToRange:=Worksheets("転記先").Range("A2")

MsgBox "完了"
End Sub

解説

1行目：Sub開始
2行目：変数の宣言
3-4行目：ActiveSheetの最終行と最終列を取得
6行目：AdvancedFilterの使用開始。CopyToRangeには転記先のセルを指定します。ここでは、”転記先”シートの”A2″を指定しています。
7行目：処理完了メッセージを表示
8行目：Sub終了

アドバンスフィルタ／別シートに項目を準備_抽出して転記２

抽出先シート準備

Sub アドバンスフィルタ_別シートに項目を準備_抽出して転記()

Dim LastRow1 As Long
LastRow1 = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row               
LastCol1 = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column    
s_row = 2
s_col = 2
Dim my_array As Variant
my_array = ActiveSheet.Range(Cells(s_row, s_col), Cells(LastRow1, LastCol1))

'my_array.AdvancedFilter _
'Action:=xlFilterCopy, CriteriaRange:=Range("K2:L3"), _
    'CopyToRange:=Worksheets("抽出先").Range("I2:J2")  'Ｉ2からＪ2に抽出列の項目を準備
    'MsgBox "完了"

ActiveSheet.Range(Cells(1, 1), Cells(LastRow1, LastCol1)).Select

Selection.AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:=Range("K2:L3"), _
CopyToRange:=Worksheets("抽出先").Range("I2:J2")       'Ｉ2からＪ2に抽出列の項目を準備

MsgBox "完了"
End Sub