オートフィルタ抽出データをコピーするマクロについて

このQ&Aのポイント
  • マクロを使用して、オートフィルタで抽出したデータを別のシートにコピーしたいが、抽出データがずれてしまう問題が発生している。
  • 問題のマクロは、指定したデータ範囲にオートフィルタを設定し、抽出データをコピーする処理を行っている。
  • 具体的には、オートフィルタが1行目ではなく2行目で設定されてしまい、タイトル行と抽出データがずれる現象が発生している。
回答を見る
  • ベストアンサー

オートフィルタ抽出データをコピーするマクロについて

マクロについて勉強中の者です。 "Sheet1"にあるデータをオートフィルタで抽出し、 "Sheet2"に抽出データのみをコピーをしたいと思っています。 Range("A10:G59").Select Selection.ClearContents With Worksheets("Sheet1").Range("A1") .AutoFilter .AutoFilter Field:=1, Criteria1:="○" .CurrentRegion.SpecialCells(xlCellTypeVisible).Copy Worksheets("Sheet2").Range("A9") End With End Sub としてみたのですが、 これを実行すると、オートフィルタが1行目(A1)ではなく、 2行目で設定されてしまい、抽出データがずれてしまいます。    A    B    C 1 品 名  仕入先  発注数 ←タイトル行に設定したい 2 りんご  ヤマト   10  ← この行に▼が設定される 色々調べた結果のマクロなので、どこが悪いのか見当がつきません。 解りやすく教えていただける方がおられましたら、よろしくお願い致します m(__)m

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

  • ベストアンサー
  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.2

こんにちは。 ご質問者さんのコード自体は、間違いではないと思います。私の知っている限りでは、そういう現象は、オートフィルタにはないからです。何かバグに近いような気がしますが……。 Excelのバージョン等は分かりますか?詳しく調べてみないと分からないです。 一応、ためしに書き換えてみましたが、これは、別にに、ご質問の要件の部分には解決していないような気がします。以下は、.Range("A1").CurrentRegion は、.Range("A1") でも、経験的には同じはずです。 Sub Test1()   Worksheets("Sheet2").Range("A10:G59").ClearContents   With Worksheets("Sheet1")     If .AutoFilterMode Then       .AutoFilterMode = False     End If     With .Range("A1").CurrentRegion       .AutoFilter Field:=1, Criteria1:="○" '品名を入れる       .SpecialCells(xlCellTypeVisible).Copy Worksheets("Sheet2").Range("A9")     End With   End With End Sub

husha-by
質問者

お礼

ご報告が遅くなって申し訳ありません m(__)m 作成していただいたコードを必要な形に修正して 新規で作成したのですが、問題なく作動してくれました! Wendy02様のコードですと、オートフィルタの解除が きちんと書かれていますが、当方にはありません。 もしかしたら、この辺が上手く作動しなかった原因でしょうか。 何にせよ、まだまだ発展途上ですので これを機会にまた勉強していきたいと思います。 今回は本当にありがとうございました♪

husha-by
質問者

補足

早々のご対応ありがとうございます。 >ご質問の要件の部分には解決していないような気がします と仰いますが、ここまできちんとコードを作っていただきましたし、 さっそく試してみます。 またご報告させていただきますね!

その他の回答 (1)

  • R48
  • ベストアンサー率24% (683/2741)
回答No.1

回答ではありませんが、 マクロの自動記録を開始し、やりたい動作を行って、記録終了 →結果を見ればHINTになると思います。

husha-by
質問者

お礼

無事に解決いたしました。 早々に対応いただきまして、本当にありがとうございました。

husha-by
質問者

補足

早々のご対応、ありがとうございます。 自動記録はためしにやってみたんですが、 抽出データのコピーが上手くいかなくて… (>_<) 見比べてみたら、違いはWith~の4行目のみなので、 もう少し調べてみます。

関連するQ&A

  • マクロでのデータの抽出&貼り付けについて

    代理店ごとに伝票書類を作成するのに、マクロを組んでいます。 シート1のデータをオートフィルタで抽出して、シート2へ貼り付けますがうまくいかないので教えていただきたいです。 代理店は10社ほどあります。 代理店ごとの伝票(シート2以降)へはシート1の必要なデータのみ貼り付けたいです。 【シート1】 A B C D E 代理店名 合計 小計 消費税 注文No 代理店A ○○○ ・・・ ・・・ aaa 代理店B ××× ・・・ ・・・ bbb 代理店A  ●●● ・・・ ・・・ ccc 代理店C △△△ ・・・ ・・・ ddd 【シート2】「代理店A」 注文No 合計 aaa ○○○ ccc ●●● 下記のマクロが間違っているのは重々承知なのですが、一応記載します。 初心者なので必要な情報があれば、追記しますので教えていただければと思います。 ★エクセルは2003です ★貼り付けるときに1行目の「注文No」や「合計」の記載は必要なし ★オートフィルタで抽出後、必要な項目のデータのみ、シート2の各指定の列に貼り付けたい Sub 代理店A() With Worksheets("シート1").Range("A1") .AutoFilter Field:=1, Criteria1:="代理店A" .CurrentRegion.SpecialCells(xlVisible).Copy Worksheets("代理店A").Range("A1") .AutoFilter End With Worksheets("代理店A").Activate End Sub

  • オートフィルターで抽出してコピー&印刷するマクロ

    いつもお世話になります。 エクセル2002です。 (1)オートフィルターでデータを抽出(部署ごと)する。(インプットボックスで) (2)抽出された行を1行ずつコピーし、【編集シート】のA1セルに貼り付け (3)【印刷シート】の印刷 (データが3行あれば3枚の印刷がしたいのです) 《データ》   A列  B列 1 (部署)(商品名) 2  01   商品1 3  01   商品2 4  02   商品1  5  02   商品3 ・・・・・・・・・・ ---------------- Sub Macro1() Dim 部署 部署 = InputBox("部署コードを入れてください") Selection.AutoFilter Field:=1, Criteria1:=部署 Range("A1").Select End Sub ------------------ ↑のマクロにどう追加すればよいのかわからないので、教えてください。 よろしくお願いします。

  • オートフィルタで「・・で始まる」数値の抽出方法

    VBAでオートフィルタを使用して「95」から始まるデータを抽出して、そのデータを1行目の項目行を省いて別シートの最終行に貼り付けするマクロを作成していますが、上手くいかない部分があり困っています。 オートフィルタはセルに入っている値が数値データの場合は「○○で始まる」検索オプションが使えない仕様とのことです。 https://support.microsoft.com/ja-jp/kb/170230 数字をテキスト形式に変換すれば文字列として扱われるので、上記の検索オプションが使えるとのことで数値が入った列を全て文字列にしようとしましたが、上手くいきません。 下記のコードが一部抜粋のコードで、A列にオートフィルタで抽出したい5桁の数値が入っているとします。 元シート(移動先シートも同じような構成でデータが入っている) A    B   C   D    E ID   品名  単価  数量  金額 92153 りんご 100   10   1000 95235 ばなな 150   15   2250 95589 みかん 50   20   1000 87896 ぶどう 200   7   1400 Dim LastRow As Long, mySt(1) As Worksheet ActiveWorkbook.Worksheets("元シート").Activate Set mySt(0) = Worksheets("元シート") Set mySt(1) = Worksheets("移動先シート") Columns("A:A").Select Selection.NumberFormatLocal = "@" '←選択列を文字列にしようとしたが上手くいかず With mySt(0) LastRow = .Cells(Rows.Count, 1).End(xlUp).Row With .Range(.Rows(1), .Rows(LastRow)) .AutoFilter Field:=1, Criteria1:="95*", Operator:=xlAnd With .SpecialCells(xlCellTypeVisible) .Copy mySt(1).Rows(1) End With End With End With また、オートフィルタで抽出したデータをコピーして、既にデータが入っている移動先シートの最終行に貼り付けたいのですが、上手くいかず、2行目に貼り付けられてしまいます。 移動先シートの最終行の取得と貼付け方法が検索してもよく分からず困っています。 2点につきまして、分かる方がいましたら教えて頂けますと助かります。 よろしくお願いいたします。

  • VBA オートフィルタで抽出したものを連続貼り付け

    下記のように情報が100近くまで存在した場合に、オートフィルターで一つずつ抽出したものをコピーし、新規シートに貼り付けたいのですが、どうすれば良いのでしょうか? 1 1 1 2 2 2 3 3 3 たとえばシート1に 1 1 1     シート2に 2 2 2 といったように処理したいので、教えて下さい。 vbaの参考書とサンプルを見て下記のように作成したのですが上手くいきません。 どんな本を読めば作成出来るようになるのかわからず、質問させていただきました。 ub オートフィルター() Dim myRng As Range Dim mySht As Worksheet Set myRng = _ Worksheets(1).Range("A1").CurrentRegion With Worksheets Set mySht = .Add(after:=.Item(.Count)) End With With myRng .AutoFilter field:=1, Criteria1:=8 On Error Resume Next .Resize(.Rows.Count - 1).Offset(1).Copy mySht.Range("A1") .SpecialCells(xlCellTypeVisible).Copy mySht.Range("A1").AutoFilter mySht.Range("A1").AutoFilter If Err.Number <> 0 Then Application.DisplayAlerts = False mySht.Delete Application.DisplayAlerts = True End If On Error GoTo 0 End With Set myRng = Nothing Set mySht = Nothing End Sub

  • オートフィルタで未入力(空白)を無視した抽出法

    いつもお世話になっております。 現在第一条件から第三条件までの入力フォームを作成し、その条件に基づいたオートフィルタを作成中なのですが、 第二条件以下に未入力の場合のオートフィルタができなくて困っています。 これら未入力(空白)でもきちんと抽出できるオートフィルタを作るにはどうしたら良いですか? 以下に私が作成したものを転記いたしますので、どなたかご教示くださいますよう、お願いいたします。 With Worksheets("業種別検索") myCriteria1 = .Range("a2").Value myCriteria2 = .Range("b2").Value      myCriteria3 = .Range("c2").Value End With With Worksheets("元データ") If Worksheets("元データ").AutoFilterMode = False Then Range("A6:z6").Select Selection.AutoFilter Else Sheets("元データ").Select Selection.AutoFilter Range("A6:z6").Select Selection.AutoFilter End If .Range("A1").CurrentRegion.AutoFilter 17, myCriteria1, xlAnd .Range("A1").CurrentRegion.AutoFilter 18, myCriteria2, xlAnd .Range("A1").CurrentRegion.AutoFilter 19, myCriteria3, xlAnd End With

  • VBA のオートフィルタについて

    ExcelVBA初心者でございます。 2点質問がございます。 (1)エクセルVBAのオートフィルタの機能を使い、"マスタ0701"シートの13行目が”ABC”の行を、"検索結果"というシートにコピーしたいです。 以下のマクロを実行しますと、まず"マスタ0701"のB1のセル(13行目はブランク)がコピーされ、その下に13行目が”ABC”に該当する行がコピーされます。 なぜ、B1セルまでコピーされるのかご教示頂けますと幸いです。 (2)また検索結果だけでなく、オートフィルタのタイトル行もコピーするようにするにはどうしたら良いでしょうか? よろしくお願いいたします。 Sub 絞り込み() With Worksheets("マスタ0701").Range("A1") .AutoFilter Field:=13, Criteria1:="ABC" .CurrentRegion.SpecialCells(xlVisible).Copy Worksheets("検索結果").Range("A1") .AutoFilter End With End Sub

  • オートフィルタで抽出したデータをVBAで貼り付けしたい

    質問させていただきます。 エクセルで仕入帳を作っています。 各取引先ごとに1枚のシートになっているのですが、 該当する月をオートフィルタで抽出して、そのデータを1枚のシートに貼り付けていき、各月ごとにデータをまとめたいと思っています。 ユーザーフォームで月を入力してオートフィルタで抽出しているのですが、データのないシートの場合不要な部分までコピー&ペーストされてしまいます。 これを回避するにはどのようにコードをかけばいいのでしょうか。 よろしくお願い致します。 現在はこのようなコードで抽出しています。 Private Sub CommandButton1_Click() Application.ScreenUpdating = False Worksheets("sheet2").Select Range("H1:H17").Select Range("H17").Activate Selection.AutoFilter Field:=8 Rows("2:2").Select Rows("2:500").Select Selection.ClearContents RowIndex = 3 '行番号の初期値設定 Do While Worksheets("目次").Cells(RowIndex, 1).Value <> "" '拾ったセルの値が空でない間ループ内の処理をする 検索値 = UserForm1.TextBox1.Text DataSheetName = Worksheets("目次").Cells(RowIndex, 1).Value Worksheets(DataSheetName).Select Range("A2").Select Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.AutoFilter Selection.AutoFilter Field:=13, Criteria1:=検索値 & "月分" Set tbl = ActiveCell.CurrentRegion tbl.Offset(2, 0).Resize(tbl.Rows.Count - 2, tbl.Columns.Count).Select Selection.Copy Worksheets("sheet2").Select IRow = Range("A" & Rows.Count).End(xlUp).Row Range("A" & IRow + 1).PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False Worksheets(DataSheetName).Select Selection.AutoFilter Field:=13 RowIndex = RowIndex + 1 '行番号カウントアップ Loop Application.ScreenUpdating = True Worksheets("sheet2").Select Range("A2").Select Unload UserForm1 End Sub

  • 抽出データのコピー

    OFFICE2016 AAのシートのA列を1件ずつ参照し、BBのシートでそれぞれに対応するデータを抽出し、CCのシートへコピーするマクロを作成していますが、 抽出したデータをコピーした後に保存すると、容量がものすごく大きくなっています。 原因は、コピー後にCCのシートが最終行まで使用されている状態になっているから。 下記は作成途中のマクロです Sub TEST() ' Sheets("CC").Select Cells.Select Selection.ClearContents Dim i As Long i = 1 Dim M As String M = Worksheets("AA").Cells(i, 1).Value Sheets("BB").Select Worksheets("BB").Range("A1").CurrentRegion.AutoFilter Field:=1, Criteria1:=M Columns("A:C").SpecialCells(xlCellTypeVisible).copy Worksheets("CC").Range("B1").PasteSpecial Paste:=xlPasteAll Application.CutCopyMode = False ' Worksheets("BB").Range("A1").CurrentRegion.AutoFilter End Sub 何が原因なのでしょう? また、その解消法教えていただきたく、よろしくお願いします。

  • マクロ オートフィルタで困っています。

    マクロ オートフィルタで困っています。 1列目と2列目からそれぞれ条件をフィルタで抽出し、抽出された行を削除するマクロを組んだのですが(下記)、Bの条件が表にない場合に2行目から下が全て削除されてしまいます。 元の表は毎週変わるため、抽出する条件があるかないかはその時次第です。 オートフィルタにこだわってはいませんが、その他の抽出方法もいまいち分からず……。 どのようにすればよいのか、教えていただけますでしょうか。 宜しくお願い致します。 <マクロ> Sub Macro() Selection.AutoFilter Field:=1, Criteria1:="A" Selection.AutoFilter Field:=2, Criteria1:="B", Operator:=xlAnd Dim gyou(1) As Long gyou(0) = 2 gyou(1) = Range("A1").CurrentRegion.Rows.Count Rows(gyou(0) & ":" & gyou(1)).Select Selection.Delete Shift:=xlUp End Sub

  • Excelマクロで他シートへの抽出:エラー

    こちらの質問 http://okwave.jp/qa/q4760155.html を参考に、エクセルマクロを作りました。 Sheet1の10列目(J)に@が入っている行をすべて、 Sheet2に抽出表示します。コードは次になります。 Private Sub Worksheet_Activate() With Sheets("Sheet1") .AutoFilterMode = False .Range("A1:N1").AutoFilter .Range("A1:N1").AutoFilter Field:=10, Criteria1:="@" .Range(.Range("A1"), .Range("A1").SpecialCells(xlLastCell)).SpecialCells(xlCellTypeVisible).Copy Range("A1") .AutoFilterMode = False End With End Sub このマクロを実行すると、確かにSheet2では抽出が行われるのですが、 同時にSheet1の内容も抽出された内容に変わってしまいます。 どこに問題があるのでしょうか。 よろしくお願いします。

専門家に質問してみよう