• 締切済み

オートフィルター VBAでの設定について

オートフィルターで0以外のものに絞って、 コピーしたいのですが、 値が0しかない場合にすべてのものをコピーするように なってしまうので、 コピーすることがないようにさせたいです。 例) Sub test() Sheets("Sheet1").Select Selection.AutoFilter ActiveSheet.Range("$A$2:$A$10").AutoFilter Field:=1, Criteria1:="<>0" Range("A2:A10").Select Range(Selection, Selection.End(xldown)).Select Selection.Copy End Sub このようなコードの場合にA2:A10の値が0しかなかった場合に コピーしている状態をなくしたいのですが、 どこのコードを変えたらいいでしょうか。 回答よろしくお願いいたします。

みんなの回答

  • chayamati
  • ベストアンサー率41% (254/607)
回答No.5

>オートフィルターで0以外のものに絞って、  コピーしたいのですが、 ★添付のようにセルA1に対象セルをSUM()して  貴方のTEST()をコピー()のサブルーチンとして  次のようにしては ---------------------------------- Sub コピー() If Range("A1") <> 0 Then TEST End Sub --------------------------------------------------------- Sub TEST() Sheets("Sheet1").Select Selection.AutoFilter ActiveSheet.Range("$A$2:$A$10").AutoFilter Field:=1, Criteria1:="<>0" Range("A2:A10").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy End Sub ★ただし Selection.AutoFilter で実行時エラーになります

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.4

下記が、見当はずれなら、すみません。 データ例 A1:B10 氏名 点数 あ1 0 あ2 0 あ3 0 あ4 0 あ5 0 あ6 0 あ7 0 あ8 12 あ9 0 として、 0以外のデータをコピーするとして Sub test02() Range("B2").AutoFilter 2, "<>0" Range("A1").CurrentRegion.Copy Range("E1") End Sub を実行すると、 シートの「見た目!」は 氏名 点数 氏名 点数 あ8 12 のようになります。「あ8 12」が見えません。 フィルタの結果も、そのB列が0のため、見えなくします。でも選別は行われています。 これはエクセルのフィルタが、該当「抜出し」ではなく、該当しないもは、「非表示にする」仕組みのため、結果を置く行などが、フィルタの結果、表示しない行だと、見た目で結果が見えません。 こういうことと関連してませんか? >以外のものに絞って は、Range("B2").AutoFilter 2, "<>0" のような書きかたで、質問のことだけなら、よいのでは。 参考WEB記事 https://daitaideit.com/vba-autofilter-copy-delete/

  • watabe007
  • ベストアンサー率62% (476/760)
回答No.3

参考に With ActiveSheet .Range("$A$2:$A$10").AutoFilter Field:=1, Criteria1:="<>0" If .AutoFilter.Range.Columns(1).SpecialCells(12).Count = 1 Then .AutoFilterMode = False Exit Sub End If .AutoFilter.Range.Copy End With

  • kkkkkm
  • ベストアンサー率65% (1618/2457)
回答No.2

A2:A10でした If WorksheetFunction.CountIf(Range("$A$2:$A$10"), ">0") Then

  • kkkkkm
  • ベストアンサー率65% (1618/2457)
回答No.1

たとえば If WorksheetFunction.CountIf(Selection, ">0") Then Selection.Copy 'コピー後の操作 End If '最後に Application.CutCopyMode = False Range("A1").Select で試してみてください。

関連するQ&A

  • Excelマクロでオートフィルターからコピペ

    ファイルのB列の値から0以外の値をオートフィルターで抽出し、値を、別のファイルのD列の一番下に貼りつけるマクロを作っていますがうまくいきません。 今作ったのは Sub macro1() If ActiveSheet.AutoFilterMode = False Then Range("A:G").Select Selection.AutoFilter Else Selection.AutoFilter Range("A:G").Select Selection.AutoFilter End If Selection.AutoFilter Field:=2, Criteria1:="<>0", Operator:=xlAnd Range("A1").Select Range("B2", Range("B2").End(xlDown)).Select Selection.Copy Windows("貼りつけるファイル名").Activate Cells(Rows.Count, 4).End(xlUp).Offset(1).Select ActiveSheet.Paste End Sub です。 フィルターで0以外の値を抽出しコピーまではできていますが、貼りつけるところでエラーがでます。 Microsoft Visual Basic 400 というエラーです。 何が悪いのか分かりません・・・。 分かる方いましたらご教授ください。よろしくお願いします。

  • EXCELのVBAを実行したら止まってしまいます。。。

    お世話になります。 下記のマクロを作ってみたのですが、シート「読込」にコピーされたところまで確認できるのですが、その後マウスが砂時計になって、動かなくなってしまいます。オートフィルタを解除する部分を削って実行してみましたが、同じところで止まりますので、貼付のところに問題があるようなのですが、何がいけないのでしょうか? また、なんかもっとスマートなプログラムになりませんでしょうか? 宜しくお願いします。 Sub test() Sheets("Normal").Select Range("A2").Select Selection.AutoFilter Field:=1, Criteria1:=Sheets("読込").Range("B2"), _ Operator:=xlAnd, Criteria2:=Sheets("読込").Range("C2") Selection.SpecialCells(xlVisible).Copy Sheets("読込").Select Range("C3").Select ActiveSheet.Paste Sheets("Normal").Select Application.CutCopyMode = False ActiveSheet.ShowAllData Selection.AutoFilter End Sub

  • オートフィルタをし選択・貼付をマクロにしたいのですが、対象データ表示される行が毎回違うのでうまくいきません。

    いつもお世話になっております。 どなたかご教示いただければ助かります。 ファイル(1)のデータの中からA行が830となっているものを、ファイル(2)のページ1の一番下の行に付け足し 同じようにファイル(1)からA行が1000となっているものを、ファイル(2)のページ2の一番下に付け足す という作業をマクロでしたいのですが、毎回830と1000がセルAの何行目に表示されるのかが異なっており、オートフィルタをかけた状態でマクロにするとマクロ作成時にたまたま表示されていた行数が指定されているので、別の日に違う行数をコピーしてしまい私が作成したマクロではうまくいきません。 どう変更すれば宜しいでしょうか? どうぞ宜しくお願い致します。 Workbooks.Open Filename:="mm.xls"    ←上記文でファイル(1) Sheets(DM).Select Rows("1:1").Select Selection.AutoFilter Selection.AutoFilter Field:=1, Criteria1:="<>*850*", Operator:=xlAnd, _ Criteria2:="<>*1000*" Range("A2").Select Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.EntireRow.Delete ActiveSheet.Rows("1:1").Select Selection.AutoFilter Windows("xx.xls").Activate  ←ファイル(2) Sheets("ll").Select   ←ページ1  ActiveSheet.Range("A1").Select Selection.End(xlDown).Select ActiveCell.Offset(1, 0).Activate Windows("mm.xls").Activate Rows("1:1").Select Selection.AutoFilter Selection.AutoFilter Field:=1, Criteria1:="1000" Rows("3:3").Select Selection.Copy Windows("xx.xls").Activate ActiveSheet.Paste Application.CutCopyMode = False Windows("xx.xls").Activate Sheets("pp").Select  ←ページ2 ActiveSheet.Range("A1").Select Selection.End(xlDown).Select ActiveCell.Offset(1, 0).Activate Windows("mm.xls").Activate Rows("1:1").Select Selection.AutoFilter Selection.AutoFilter Field:=1, Criteria1:="850" Rows("2:2").Select Selection.Copy Windows("xx.xls").Activate ActiveSheet.Paste Application.CutCopyMode = False ActiveWorkbook.Save Windows("mm.xls").Activate ActiveWindow.Close End Sub

  • オートフィルタのマクロについて

    オートフィルタのマクロを組もうとしているのですが、フィルタ条件に別シートのセルの値を入れたいのですが、そこがどうもうまくいきません。 作成したマクロは以下の通りです。 Sub 累計計算マクロ() Dim aRange As Range, bRange As Range, i As Date Set aRange = Sheets("累計").Range("B1") Set bRange = Sheets("累計").Range("B2") i = aRange.Value Sheets("クイーンエステート").Activate Range("A13:L13").Select Selection.AutoFilter Selection.AutoFilter Field:=2, Criteria1:="<=i", Operator:=xlAnd End Sub どなたか助けてください! 宜しくお願い致します。

  • ExcelのVBAです。

    先日お答えいただいたVBAなんですが、 Sub Macro1() Sheets("Sheet1").Select Range("A1").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("Sheet3").Select Range("A1").Select ActiveSheet.Paste Selection.End(xlDown).Select Application.CutCopyMode = False Do Selection.Insert Shift:=xlDown Selection.End(xlUp).Select Loop Until ActiveCell.Address = "$A$1" End Sub というのを使用させて頂いてます。 これを、コピー先のものを上書きせずに、コピーされたものがあれば表示させるといった風に出来ないでしょうか? 例  A    A 1 a 1 2 b → 2あ 3 c 3 右から左に一行間隔で別シートに表示させたいのですが、  A  1 a 2 あ 3 b 4 5 b という結果にしたいのです。 拙い文章で申し訳ないのですが、教えて頂きたいです。

  • マクロ 可視セルへコピーする方法

    こんにちは。よろしくお願いします。 A~V列、300~400行程度の表を作っています。 8行目をコピーして空白行へペーストしたいのですがどのようにすれば良いでしょうか。 マクロの記録でつくったものは ActiveSheet.Paste でエラーになります。 またペースト開始行をA17ではなくて可変なものに変えたいです。 よろしくお願いします。 Sub 下までコピー() Range("A8:V8").Select Selection.Copy Selection.AutoFilter Field:=2, Criteria1:="=" Range("A17:V" & Range("B5").End(xlDown).Row).Select Selection.SpecialCells(xlCellTypeVisible).Select ActiveSheet.Paste Application.CutCopyMode = False Selection.AutoFilter Field:=2 End Sub

  • ExcelVBAについて。

    Sub データ抽出() ' ' データ抽出 Macro ' ' Sheets("オリジナルデータ").Select Range("A1").Select Selection.AutoFilter ActiveSheet.Range("$A$1:$E$1000").AutoFilter Field:=2, Criteria1:="TR-A" Columns("A:E").Select Selection.Copy Range("B371").Select Sheets("TR-A").Select Range("A1").Select ActiveSheet.Paste Sheets("オリジナルデータ").Select Application.CutCopyMode = False Selection.AutoFilter Sheets("オリジナルデータ").Select End Sub コピーした後にTRーAを抽出した後に、どうやってB371を選択するのでしょうか?教えていただけると嬉しいです。もし、マクロの記録で作った場合です。 以下のURLをダウンロードしていただけないでしょうか?この章のチャプター5です。 https://www.shuwasystem.co.jp/support/7980html/2606.html

  • マクロでシート2~6のデータをシート1に転記したい

    マクロでシート2~6のデータをシート1に転記したいです。 シート2~6のデータを シート1に順番に転記したくてマクロの記録を利用して作成しました。 シート2~6は列は同じですが行数は異なります。 また行数は作業の都度異なります。 同じ記述が繰り返されているので もう少し記述が短くできるのではと思うのですが どうすればいいでしょうか? Sub データ更新() 'シート1の前回データをクリア Sheets("シート1").Select Range("A2:Q2").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents Range("A2").Select Sheets("シート1").Select Range("A1").Select Sheets("シート2").Select Range("A1").Select 'ヘッダーも合わせて取得 Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート1").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select Sheets("シート3").Select Range("A2").Select 'データのみ取得 Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート1").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select Sheets("シート4").Select Range("A2").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート1").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select Sheets("シート5").Select Range("A2").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート1").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select Sheets("シート6").Select Range("A2").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート1").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select End Sub

  • ExcelVBAについて。

    Sub データ抽出() ' ' データ抽出 Macro ' ' Sheets("オリジナルデータ").Select Range("A1").Select Selection.AutoFilter ActiveSheet.Range("$A$1:$E$1000").AutoFilter Field:=2, Criteria1:="TR-A" Columns("A:E").Select Selection.Copy Range("B371").Select Sheets("TR-A").Select Range("A1").Select ActiveSheet.Paste Sheets("オリジナルデータ").Select Application.CutCopyMode = False Selection.AutoFilter Sheets("オリジナルデータ").Select End Sub で、Range(″B371″)がなくても良いのでしょうか?後、この後のプログラムを1行ずつ解説して頂けないでしょうか?教えていただけると嬉しいです。もし、マクロの記録で作った場合です。 以下のURLをダウンロードしていただけないでしょうか?この章のチャプター5です。 https://www.shuwasystem.co.jp/support/7980html/2606.html

  • excelVBAについて。

    Sub データ抽出() ' ' データ抽出 Macro ' ' Sheets("オリジナルデータ").Select Range("A1").Select Selection.AutoFilter ActiveSheet.Range("$A$1:$E$1000").AutoFilter Field:=2, Criteria1:="TR-A" Columns("A:E").Select Selection.Copy Range("B371").Select Sheets("TR-A").Select Range("A1").Select ActiveSheet.Paste Sheets("オリジナルデータ").Select Application.CutCopyMode = False Selection.AutoFilter Sheets("オリジナルデータ").Select End Sub で、Range(″B371″)がなくても良いのでしょうか?後、この後のプログラムを1行ずつ解説して頂けないでしょうか?教えていただけると嬉しいです。 以下のURLをダウンロードしていただけないでしょうか?この章のチャプター5です。 https://www.shuwasystem.co.jp/support/7980html/2606.html

専門家に質問してみよう