マクロを使い、オートフィルターする方法

Question

前提・実現したいこと

オートフィルターのVBAで教えてほしい事があります。
Excelで在庫管理をしようとしています。
DATAにA列からE列で記載された条件を用いて一個づつSheet1にフィルターをかけて、Sheet2に記載していきたい。

Private Sub CommandButton1_Click()
Dim aaa As Variant
   aaa = Array(2, 4, 6, 7, 9, 10)
Dim MotoRng As Range
    Set MotoRng = Worksheets("Sheet1").Range("A1")
    

    With Worksheets("Data")
        Dim maxRow As Long
        maxRow = .Range("A" & Rows.Count).End(xlUp).Row
        '"Data"の2行目から順にループ処理
        Dim rw As Long, cl As Long
        For rw = 2 To maxRow
            MotoRng.AutoFilter             'AutoFilter解除
            '2, 4, 6, 7, 9, 10列を条件にフィルタをかける
            For cl = 2 To UBound(aaa)
            
                MotoRng.AutoFilter cl, .Cells(rw, cl).Value
            Next
            'フィルタをかけた"Sheet1"のデータを"Sheet2"に追加コピーする
            With Worksheets("Sheet2")
                Dim Sheet2MaxRow As Long
                Sheet2MaxRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
                MotoRng.CurrentRegion.Copy .Range("A" & Sheet2MaxRow)
            End With
        Next
    End With

追加

Private Sub CommandButton1_Click()
Dim aaa As Variant
   aaa = Array(2, 4, 6, 7, 9, 10)
Dim MotoRng As Range
    Set MotoRng = Worksheets("Sheet1").Range("A1")
    

    With Worksheets("Data")
        Dim maxRow As Long
        maxRow = .Range("A" & Rows.Count).End(xlUp).Row
        '"Data"の2行目から順にループ処理
        Dim rw As Long, cl As Long
        For rw = 2 To maxRow
            MotoRng.AutoFilter             'AutoFilter解除
            '2列目から6列目までを条件にフィルターをかける
            For cl = 0 To UBound(aaa)
             Debug.Print cl
             Debug.Print rw
                    
             MotoRng.AutoFilter aaa(cl), .Cells(rw, cl + 1).Value
            Next
            'フィルターをかけた"Sheet1"のデータを"Sheet4"に追加コピーする
            With Worksheets("Sheet4")
                Dim Sheet4MaxRow As Long
                Sheet4MaxRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
            
                           
             Intersect(Range("A1").CurrentRegion, Range("B:B,D:D,G:G,M:M")).Copy _
    Sheets("Sheet4").Range("A" & Sheet4MaxRow)
            End With
        Next
    End With

    MotoRng.AutoFilter             'AutoFilter解除

End Sub

Comments

[meg_]

コードは「コードの挿入」で記入してください。

[meg_]

>規則性のない場合の方法を探しています
配列を使用してはどうでしょうか？　※配列を知らない場合は調べてください。

[m_ao]

すみません。「コードの挿入」しました。
配列も試して、コードを追記してみましたが、うまくできませんでした。（コード追記しました）

[hatena19]

「オートフィル」と「オートフィルター」は別の機能ですので、タイトルと質問文内の「オートフィル」の修正をお願いします。

エクセルのオートフィルで連続データをサクっと入力 https://www.becoolusers.com/excel/autofill.html

[m_ao]

ありがとうございました。誤記修正いたします。

Answer 1

下記でどうでしょうか。

Private Sub CommandButton1_Click()
    Dim aaa As Variant
    aaa = Array(2, 4, 6, 7, 9, 10)
    Dim MotoRng As Range
    Set MotoRng = Worksheets("Sheet1").Range("A1")

    With Worksheets("Data")
        Dim maxRow As Long
        maxRow = .Range("A" & Rows.Count).End(xlUp).row
        '"Data"の2行目から順にループ処理
        Dim rw As Long, cl As Long
        For rw = 2 To maxRow
            MotoRng.AutoFilter             'AutoFilter解除
            '2, 4, 6, 7, 9, 10列を条件にフィルターをかける
            For cl = 0 To UBound(aaa)
                MotoRng.AutoFilter aaa(cl), .Cells(rw, cl + 1).Value
            Next
            'フィルターをかけた"Sheet1"のデータを"Sheet2"に追加コピーする
            With Worksheets("Sheet2")
                Dim Sheet2MaxRow As Long
                Sheet2MaxRow = .Range("A" & Rows.Count).End(xlUp).row + 1
                MotoRng.CurrentRegion.Copy .Range("A" & Sheet2MaxRow)
            End With
        Next
    End With
End Sub

修正したのは、下記の2行だけです。

            For cl = 2 To UBound(aaa)
                MotoRng.AutoFilter cl, .Cells(rw, cl).Value

↓

            For cl = 0 To UBound(aaa)
                MotoRng.AutoFilter aaa(cl), .Cells(rw, cl + 1).Value

Dataシートの1列目から6列目の値が、各々Sheet1の2列目、4列目、6列目、7列目、9列目、10列目の条件になる。
Array関数で生成した配列は、インデックスが0から始まる。

上記を考慮して、抽出対象列は aaa(cl) で、条件値は Worksheets("Data").Cells(rw, cl + 1).Value で取得できる。

コメントに対する回答

具体的には商品（B列）、CODE（D列）、STORE(G列）、STOCK(M列）だけをSheet2に抽出する方法が知りたかったです。

下記でどうでしょうか。（コード修正しました。）

Intersect(MotoRng.CurrentRegion, Worksheets("Sheet1").Range("B:B,D:D,G:G,M:M")).copy _
    .Range("A" & Sheet2MaxRow)

Comments

[m_ao]

解決しました。うまく動いているようです。ありがとうございました。

[m_ao]

解決済みですが、この場を借りて申し訳ありません。自分用には上記で問題ないのですが、外部用に表示列を絞りたく、Array関数で生成した配列（aaa)を、MotoRng.CurrentRegion.Copy .Range("A" & Sheet2MaxRow)をどう修正したらできるか教えてください。
にも

[hatena19]

「外部用に表示列を絞りたく」とは具体的にどのようにしたいのでしょうか。これだけではなんのことか分かりません。

[m_ao]

具体的には商品（B列）、CODE（D列）、STORE(G列）、STOCK(M列）だけをSheet2に抽出する方法が知りたかったです。

[hatena19]

回答に追記しましたので、ご参照ください。

[m_ao]

回答ありがとうございました。回答頂いたコードを元に追記してみましたが、解決済みの時にできていたことがうまくできなくなりました。
私自身Intersectが理解できておらず、再度コード挿入をしましたので、アドバイスを頂きたくお願いします。

[hatena19]

テスト用のコードをそのまま貼り付けてました。回答のコードを修正しましたので参照してください。

[m_ao]

ありがとうございました。出来ました。
解決済みにも関わらず、hatena19さんにはアドバイスを頂いたことで勉強になりました。

Answer 2

この状態ですと、オートフィルで検索できるものがなく、見出しのみがSheet2に表示されます。どうすれば解決できますでしょうか。

DataシートのタイトルとSheet1シートのタイトルが一致していないのが原因ではないでしょうか？
それにより、オートフィルタをかけている列と検索対象のセル値の不一致が起きているかと思われます。

---

【追記】
他の回答者も書かれていますが、配列から値を取り出すのはaaa(cl)ですね。