VBA データ抽出しコピー

Question

 'Sh1のデータをオートフィルターする
    With Sh1.Range("A1")
     .AutoFilter field:=1, Criteria1:=keyWord
     .CurrentRegion.Offset(1, 0).Resize(.CurrentRegion.Rows.Count - 1, 29).Select
     .Range("A:A, C:C, K:K, O:P, S:S, U:U, AA:AC").Copy
    End With

＜やりたいこと＞
A列からAC列まであるデータで、オートフィルター後、A,C,K,O:P,S,U,AA:ACだけを
Sheet2に転記したいです。

＜エラー箇所＞
上記を実行しますと、Sheet1でフィルターをかけた見出し(１行目）までコピーされてしまいました。

Answer 1

    With Sh1.Range("A1")
     .Range("A:A, C:C, K:K, O:P, S:S, U:U, AA:AC").Copy

こうRangeプロパティで列を指定すると、「シート上の列全体」を指定いることになります。
Columnsプロパティですると、元のセル範囲の列になるんですが、飛び飛びで指定できません。
なので、
1）列毎にコピペを繰り返す
2）コピーした後不要な列を削除する
というようなことをしても結果は同じなので、そのように書くことも可能です。
ですが、どうしてもセル範囲を限定したいということであれば、
Intersect関数という関数で、セル範囲の積集合を求めることが可能ですので、
それを使うことで可能になります。

Sub test()
    Dim rngFrom As Range
    Dim rngTo As Range
    Dim sKey As String
    
    Set rngFrom = Worksheets("Sheet1").Range("A1").CurrentRegion
    With Worksheets("Sheet2")
        .UsedRange.ClearContents
        Set rngTo = .Range("A1")
    End With
    sKey = "2"
    
    With rngFrom
        .AutoFilter field:=1, Criteria1:=sKey
        .Range("A:A, C:C, K:K, O:P, S:S, U:U, AA:AC").Select
        Intersect(.Cells, .Offset(1), .Range("A:A, C:C, K:K, O:P, S:S, U:U, AA:AC")).Select
        Intersect(.Cells, .Offset(1), .Range("A:A, C:C, K:K, O:P, S:S, U:U, AA:AC")).Copy rngTo
    End With
End Sub

※Selectすることは無意味です。
ステップインで1行ずつ実行して、
どのようなセル範囲が特定できているかを視覚化し確認するためにSelectしています。
動作が重くなったり、画面がチラチラすることを防ぐため、
動作確認後、運用時にはその行を削除してください。

Comments

[koko2]

ありがとうございました。画面がチラチラも気になってました。
回答頂き、とても助かりました。

[koko2]

Sheet2の最終行（先に抽出したデータの下）にデータを追加していくには rngToのところ下記に変えればいいでしょうか？
=Cells(Rows.Count, "A").End(xlUp).Row + 1

[koko2]

解決しました。すみませんでした。

[mattuwan]

Set rngTo = .cells(.rows.count,"A").end(xlup).offset(1)

ですね。ピリオドを忘れずに。

行番号だけをわざわざ取り出さずに、セルそのものを変数に代入することを覚えましょう。

[koko2]

アドバイスありがとうございます。
そうですねこれからも勉強していきます。
ありがとうございました。