エクセルVBA：特定の列だけ抽出して別ブックに転記したい

Question

前提・実現したいこと

現在は条件が合った行すべてが出力されています。
↓それを
条件が合った内容の行を、さらに指定した列のみ（K,Q）だけを出力して別ブックに転記したい。

該当のソースコード

※個人的なパスやファイル名は伏せています。

Sub 抽出ボタン()

' 不要なダイアログ出力を抑制
Application.DisplayAlerts = False
' 画面の更新処理を停止
Application.ScreenUpdating = False
 
'ブックのパスを設定
Dim filePath As String
filePath = "C:\○○○\Desktop\test1.xlsx"
 
'ブック作成
With Workbooks.Add
 
    ' 既存ブックから新規ブックへコピーするシートを指定する
    ' シート名もコピー元のシート名になる
    ' Field=左から数えた列 Criteria1:=抽出条件の指定
    ThisWorkbook.Sheets(Array("マスタA")).Copy Before:=.Sheets(1)
    Range("A1").AutoFilter Field:=17, Criteria1:=">10"
 
    ' 新規作成したブックを保存する（※拡張子によってFileFormatが違う）
    .SaveAs fileName:=filePath, FileFormat:=Excel.XlFileFormat.xlOpenXMLWorkbook
     
    ' 新規作成したファイルを閉じる
    .Close
End With

End Sub

試したこと

ThisWorkbook.Sheets(Array("マスタA")).Copy Before:=.Sheets(1)
Range("A1").AutoFilter Field:=17, Criteria1:=">10"

この行で「Criteria1:=">10"」（数値が10以上）の条件が合った行を抽出して、別ブックに転記される記述にしました。

このあと実現したいことに記載したように、さらに特定した列だけにしぼって出力したいのですが手が詰まってしまいました。

補足情報（FW/ツールのバージョンなど）

まだ手探り状態ですので、たくさんコメントアウトの記述がありますが気にしないでください。。

Answer 1

条件が合った内容の行を、さらに指定した列のみ（K,Q）だけを出力して別ブックに転記したい。

この機能は、「フィルターオプション」という機能に実装されいます。

手動だと、手順が結構めんどいですし、不要にシートを汚すので、
スマートではないですが、VBAで制御するなら、驚くほどコードが簡素化出来て便利です。
ぜひ、使ってみてください。

Answer 2

もし「別のブックから、データのあるExcelファイルを覗きにいって、条件が合った内容の行を、さらに指定した列だけを（列番号ではなくて表の中の列名で）抽出して、その別のブックに表示したい。 」ということでもよろしければ、MicrosoftQueryが使いやすいと思います。
http://www.eurus.dti.ne.jp/~yoneyama/Excel/filter2.htm
に簡単な事例があります。ここの「システムテーブル」のチェックだけ入れ忘れないようにしてください。

なお、Microsoft Query によって表示された表は、VBAでは「QueryTableオブジェクト」として操作することもできます。
そこでSQLでの命令文も使えますので、ワークシート関数を多用したり、ループなどを使ったプログラムを作るよりはらくちんではないかと思います。

以下のコードは「D:\test88\test01.xls」というファイルの「Sheet1]を覗きに行って、Sheet2に表示させます。
覗きに行く「Sheet1」は「"SELECT * FROM Sheet1$"」のところで指定してます。
長いSQL文は、各句ごとに、Arrayにてカンマで区切って、CommanText（配列）に格納します。
もし、CommanTextが配列じゃなかったら、カンマで区切らずに1行の長い命令文として格納します。

CommanTextが配列かそうじゃないかは、一つ何らかの複雑な条件のMicrosoftQueryの結果の表を手動で作ってみて、それのCommanTextの内容をVBAでイミディエイトに表示させ、複数行に分かれて出てきたら配列と思っていいです。1行だけなら配列じゃないかもです。
配列だったらArreyを使うし、配列じゃなかったら、Arreyは要りません。

周囲に、AccessやSQLがわかる人が居ましたら、こちらの方法も今後便利かと思います。
複数の条件であっても、1つ1つが複雑でないとか、リレーション（VlookUp関数のような紐つけ）も同時に使いながらとか、でしたら、通常のVBAでデータ抽出するよりははるかにラクです。

※こちらのテストでは、xlsにも、xlsmに対しても、覗きにいくことができました。
（ダメだったらすみません！）

なお、もし、何らかの条件で（K,Q）の列のみを取り出したいとこは、Arreyのところで、

SELECT K列に相当する列名, Q列に相当する列名 FROM シート名$ WHERE 条件としたい列名 >= 10;

みたいな感じで書きます。（SELECTやFROMなどの命令語句の前後には半角スペースが必要です。）
WHEREの条件句のところでは、OrやAndなども使って複数の条件が設定できます。

詳しくは、Webや先輩、分かる人などに聞いてみてください。

ここで書いたのはあくまで参考例ですので・・・。

※コメントがやたら長いので、不要なら全部消して見てみてください。
コード自体はかなり少ないです。

なお、他のブックに書き込みたいなら・・・、
・CreateObject関数・GetObject関数（実行時バインディング）、
あるいは、Newキーワード（事前バインディング）を使って
ファイルを非表示のまま開いて書き込む方法。
・閉じたファイルに書き込みたいなら、DAOやADOにて、
ループ＋Update系メソッド又はSQL＋Execute系メソッドを使って書き込む方法。
・・・などがあります。

Sub test301()
 
    Dim objQtbl01       As QueryTable
    Dim strCnn01        As String
    
    
    '接続文字が長くて見にくいので、見やすく扱いやすくする
    
    strCnn01 = strCnn01 & "ODBC;"
    strCnn01 = strCnn01 & "DSN=Excel Files;"
    strCnn01 = strCnn01 & "DBQ=D:\test88\test01.xls;"
    strCnn01 = strCnn01 & "DefaultDir=D:\test88;"
    strCnn01 = strCnn01 & "DriverId=790;"
    strCnn01 = strCnn01 & "MaxBufferSize=2048;"
    strCnn01 = strCnn01 & "PageTimeout=5;"
    
                'ここで書き換えるのは基本、
                '「DBQ=・・・」のフルパスと、
                '「DefaultDir」のフォルダパスと、
                '「Destination・・・」のシート名や表の起点のセル（Rangeのところ）
                'あと、次段階の「.CommandText = Array（・・・）」の行のそのSQLの内容
                'でOKかと思います。
                '       
    
    'もしSheet2にMicrosoftQueryの結果の表（＝QueryTablesオブジェクト）が
    '無かったら、作って表示させる処理。
    '
    
    If (Worksheets("Sheet2").QueryTables.Count <= 0) Then
        
        'もしSheet2にMicrosoftQueryの結果の表が
        '無かったら以下の処理
        
        '以下の内容でSheet2にMicrosoftQueryの結果の表を作成。
        'フルパスは恐らくUNCパス、つまり、他のPCの共有フォルダのxlsでも
        '良いのではないかと思います。（ダメだったらすみません！）
 
        ’空っぽいのMicrosoft QueryオブジェクトをSheet2のB2セルを起点に作る処理。
           
        Set objQtbl01 = Worksheets("Sheet2").QueryTables.Add( _
                        Connection:=strCnn01, _
                        Destination:=Worksheets("Sheet2").Range("B2"))
        

                '今回のこの例でのSQL文では、Sheet2に対して、
                '「B2」セルを起点としてMicrosoftQueryの結果の表を作成します。
                'この時点では、オブジェクトしては作成されているのですが、
                'まだ条件設定とかしてないので、Sheet2には何も表示されません。

                'なお、「Worksheets("Sheet2").」を「Activesheet.」に書き換えると、
                '現在表示しているシートに結果の表が生成されます。
                '
                'また、SQL文（表操作の命令文）の中では、
                'test01.xlsのSheet1（＝システムテーブル）のことを「`Sheet1$`」と
                '表現しているのですが、これは「システムテーブルと認めさせるために、
                'シート名に「$」を末尾に付けている・・・」ということになります。
                'また、Microsoft QueryのSQLの仕様として、そのテーブル名を
                '「`」バッククォートで囲んでいます。[ ] で囲んでもOKです。
                'バッククォートはShiftキーを押しながら「@」を押します。
            

    
            'QueryTablesオブジェクトのSQLを書き換え。
            '（このサンプルでは、毎回、空っぽの状態にSQL文が入ります。）
            objQtbl01.CommandText = Array("SELECT * FROM `Sheet1$`")     

            '書き換えたSQLを実行して表に反映。
            '空っぽのMicrosoftQueryのオブジェクトの中に、SQL文で指定した内容の
            '表ができあがる・・・みたいな雰囲気です。
            'ここではじめて、表が表示されます。
            '（もともと何も表示されてない場合は、表が自動的に新規作成されます。）
            objQtbl01.Refresh                                            
            Exit Sub    

    Else
    
        'もしすでに、Sheet2にMicrosoftQueryの結果の表が
        'あったら何もしないで次へ。
 
    End If
    
    
'    'もし、作ったMicrosoft Queryの結果の表が表示されなかったら
'    '以下の2行のコメントアウトをはずしてテストしてみます。
'    Worksheets("Sheet2").QueryTables(1).CommandText = Array("SELECT * FROM `Sheet1$`")      'SQLの再指定
'    Worksheets("Sheet2").QueryTables(1).Refresh BackgroundQuery:=False          'SQLの実行と表示
    
    
    
End Sub
'

Answer 3

元シートでフィルターしたあと各列をコピペすれば必要なデータだけコピーされます。

With Workbooks.Add
    Set tgt = .Sheets(1)
    Set base = ThisWorkbook.Sheets(1)

    base.Range("A1").AutoFilter Field:=4, Criteria1:=">10"
    
    c = 1
    For Each a In Array("A", "C")
        base.Range(base.Cells(1, a), base.Cells(1, a).End(xlDown)).Copy tgt.Cells(1, c)
        c = c + 1
    Next
    .Close
End With

Answer 4

オートフィルタで列は絞れないので
「シートを丸ごとコピーするのではなく必要な列のみコピーする」
または
「オートフィルタの後に不要な列を削除する処理を入れる」
でどうでしょうか？

「特定した列だけにしぼって出力したい」というのが、「不要列のデータは削除せず残したい」という意味であれば
オートフィルタとは違いますが、「列の非表示」や「グループ化」になるかと思います。

Comments

[tsunana]

回答ありがとうございますm(__)m
そうですね、、実際は元ブックの「K」「Q」列だけが別ブックに転記された状態であれば良いので処理的には「必要な列のみコピーする」や「オートフィルタの後に不要な列を削除する処理を入れる」でも良いかもしれません。あとは処理速度？でどっちが良いかになってくる感じですね。。

[kobac]

一度すべてコピーしてから削除するよりは、最初から必要な列だけコピーする方が速いかと。
元ブックのデータ件数が多く、さらに計算式まで入っていたりすると、削除の際の再計算で遅くなりそうです。