エクセルVBAでオートフィルタの結果をコピーして別シートに貼り付け

質問

よろしくお願いします。今下のようにコードを書いています。
見よう見まねですが・・・。
追加情報の範囲をデータシートのデータのある最終行の下に
入れるものなのですが、
追加情報シートでオートフィルタをかけてから、その結果を
貼り付けたいのですが、コードをどのようにつなげたらいいか
教えていただけないでしょうか。
追加情報シートのBD列で、0より大きい値を抽出して、それを
元の(下のコード)のようにサイズを変更して、貼り付けたいと思います
よろしくお願いします。

With Worksheets("追加情報").Range("AA1").CurrentRegion
.Offset(1, 2).Resize(.Rows.Count - 1, .Columns.Count - 2).Copy
End With
Worksheets("データ").Range("C65536").End(xlUp).Offset(1). _
PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Sub オートフィルタ()

Range("BD1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=30, Criteria1:=">0", Operator:=xlAnd
End Sub

回答No.3

Nayuta_X · ベストアンサー

下記は、データ間に空白(空白列)が、ない場合使用します。

ActiveCell.CurrentRegion.Select

もし、データ間に空白(空白列)がある場合は、下記と入れ替えてください。

ActiveSheet.UsedRange.Select

回答No.2

Nayuta_X

**** サイズを変更して ****　は、ご自分で、考えてちょうだい。
以下は、修正したものです。

Sub オートフィルタ()

'注意; 一行目には、項目など　オートフィルタの対象外のものを入れるようにしましょう。
' で、ないと　抽出されていない　データも抽出されることがあります。
' それは、一行目のデータが、いつも抽出　データに　含まれることになるからです。

Dim MyCode As String
Dim Rng As Range

Range("A1").Activate
ActiveCell.CurrentRegion.Select
Hx = ActiveWindow.RangeSelection.EntireColumn.Count '列数の取得
Vy = ActiveWindow.RangeSelection.EntireRow.Count '行数の取得

Range("BD1:BE1").Select 'Range("BD1").Select としたい所だが　問題ありで、しない　なんでか??。　よ～～く考えてね。
Selection.AutoFilter

Selection.AutoFilter Field:=1, Criteria1:=">0", Operator:=xlAnd ' Field:=30 となっていたが、なぜ??
Set Rng = Range("A1").CurrentRegion 'アクティブセル領域取得

Rng.CurrentRegion.SpecialCells(xlCellTypeVisible).Select ' オートフィルタで抽出したセルを指定

myRow = 0

For Each myArea In Selection.Areas ' オートフィルタで抽出したセルの数を算出する
myRow = myRow + myArea.Rows.Count
Next

If myRow = 1 Then

MsgBox "抽出された　データは、ありませんでした。 ", vbOKOnly

End
End If

Range(Cells(2, 1), Cells(Vy, Hx)).Select ' ここは、変更しない方が良いです。
Application.CutCopyMode = False ' ここは、必要に応じ変更します。
Selection.Copy

Worksheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste

Rng.AutoFilter 'フィルタ解除
Range("A1").Select

End Sub

では、別の　困ったさんの回答もしないと　いけないので　これでごめん。
なにか、質問あれば、受け付けます。

回答No.1

Nayuta_X

下記URLから　■（２）抽出データのコピー＆ペースト■を
参照してください。
他にも　参考になるものが、ありますので　ページを開いて見てください。

Sub Macro1()

Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="000001"

Selection.SpecialCells(xlCellTypeVisible).Select’可視セルの選択
Selection.Copy

Sheets("Sheet2").Select 'シートを切り替えて貼り付け
Range("A1").Select
ActiveSheet.Paste

Sheets("Sheet1").Select 'もとのシートに戻る
Application.CutCopyMode = False
Selection.AutoFilter 'オートフィルタ解除

End Sub

まず、VBA最初の一歩（その３）の考え方に基づいて不要なSelect命令を削り、さらに
上記（１）オートフィルタの設定の手法で変数とInputBoxメソッドを利用する方法に
手直しします。CopyメソッドのDesitination引数を利用する方法も忘れずに行いましょう。

Sub MyFilter()

Dim MyCode As String
Dim Rng As Range

Set Rng = Range("A1").CurrentRegion 'アクティブセル領域取得
Rng.AutoFilter 'フィルタ設定

MyCode = Application.InputBox("コード番号入力", Type:=2)
Rng.AutoFilter Field:=1, Criteria1:=MyCode '変数MyCodeに格納されたデータ抽出

'可視セルをコピー
Rng.SpecialCells(xlCellTypeVisible).Copy _
Destination:=Sheets("Sheet2").Range("A1")

Rng.AutoFilter 'フィルタ解除

End Sub

参考URL：

http://www.moug.net/tech/exvba/0150067.htm

お礼

お礼が大変遅くなり本当に申し訳ございません。3つもご回答いただいておきながら・・・。おかげで解決できました。ありがとうございました。

補足

貴重なサンプルをご提示いただきありがとうございました。私の頭の出来がよくなく、応用がきかないもので・・・はずかしい・・・。
今回の私の質問のものでいただけると本当に助かります。