こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセル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

投稿日時 - 2007-06-16 14:30:36

QNo.3089560

すぐに回答ほしいです

質問者が選んだベストアンサー

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

ActiveCell.CurrentRegion.Select

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

ActiveSheet.UsedRange.Select

投稿日時 - 2007-06-17 17:47:50

このQ&Aは役に立ちましたか?

2人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.2

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

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

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

投稿日時 - 2007-06-17 15:51:05

ANo.1

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

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最初の一歩(その3)の考え方に基づいて不要なSelect命令を削り、さらに
上記(1)オートフィルタの設定の手法で変数と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

投稿日時 - 2007-06-16 16:54:07

補足

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

投稿日時 - 2007-06-16 21:19:56

お礼

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

投稿日時 - 2007-07-01 18:00:20

あなたにオススメの質問