Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
12972 / 13655 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【7744】オートフィルタで検出した値を別シートに貼り付け tamago 03/9/16(火) 20:39 質問
【7745】Re:オートフィルタで検出した値を別シート... Asaki 03/9/17(水) 0:16 回答
【7749】Re:オートフィルタで検出した値を別シート... tamago 03/9/17(水) 7:20 お礼
【7744】オートフィルタで検出した値を別シートに...
質問  tamago  - 03/9/16(火) 20:39 -
引用なし
パスワード
   いつもお世話になります。

ブック調査
部品コード　　物質名　　含有の有無
1234　　　　　鉛　　　　　○
1234　　　　　金
1234　　　　　アンモニア　　　　

エクセルブック“調査”でオートフィルタを使って含有が○のものを抽出してその結果をまとめブックの最終行にはりつけたいのです。（抽出結果はその都度違います）自動記録を使うと下記のようなコードになりました。これの２個あるRangeのところをなおせばよいのだろうとはおもうのですが、どう直したらよいかわかりません。よろしくお願いします。


ActiveWindow.SmallScroll Down:=-21
　　Selection.AutoFilter
　　Selection.AutoFilter Field:=3, Criteria1:="○"
　　Range("A19:C19").Select
　　Selection.Copy
　　Windows("貼り付け.xls").Activate
　　ActiveWindow.SmallScroll Down:=-3
　　Range("A2").Select
　　ActiveSheet.Paste
【7745】Re:オートフィルタで検出した値を別シート...
回答  Asaki  - 03/9/17(水) 0:16 -
引用なし
パスワード
   こんばんは。
↓のような感じで如何でしょうか？

貼り付け.xls を予め開いておき、ブック調査の必要な範囲を選択して実行してください。
なお、貼り付け.xlsの貼り付け先のシート名が不明のため"Sheet1"に貼り付けるものとしています。
☆マークの行の"Sheet1"を、実際のシート名に直してください。

Sub test()

　　Dim rngTemp　　　　 As Range

　　Selection.AutoFilter Field:=3, Criteria1:="○"
On Error Resume Next
　　Set rngTemp = Selection.Offset(1). _
　　　　　　Resize(Selection.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
　　If rngTemp Is Nothing Then GoTo Exit_Sub
On Error GoTo 0
　　rngTemp.Copy Destination:=Workbooks("貼り付け.xls").Worksheets("Sheet1"). _
　　　　　　Range("A65536").End(xlUp).Offset(1)　　　　 '☆

Exit_Sub:
　　Set rngTemp = Nothing
　　Selection.Parent.AutoFilterMode = False
　　Selection.Cells(1).Select

End Sub
【7749】Re:オートフィルタで検出した値を別シート...
お礼  tamago  - 03/9/17(水) 7:20 -
引用なし
パスワード
   Asaki さん
回答ありがとうございました。ばっちりペーストでき感激です。これで処理時間が大幅に短縮されます。ありがとうございました！！
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
12972 / 13655 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free