オートフィルタで抽出後、マクロでコピー＆貼り付け

質問

初めまして、エクセル初心者です。
以下のマクロを、自動記録でやろうとすると、うまくいきません。
類似質問を検索してみたものの、初心者のためアレンジがきかず・・・
他力本願な質問になり、大変申し訳ないのですが、
どなたかお手すきのときに教えていただけると、
とてもうれしいです。

【やりたいこと】

(1)Ｂｏｏｋ1のファイルで、
　オートフィルタでデータを抽出後、
　抽出したデータのＢからＤのセルをコピーし、
　別ファイル、Ｂｏｏｋ2のファイルの、
　*ＢからＤに「値」で貼り付けたい。

　*Ｂｏｏｋ2のＢからＤは、
　 上段までデータが入力してある状態で、
　 そのすぐ下段（空白）のＢからＤへ貼り付けたい。

(2)Ｂｏｏｋ1（コピー元ファイル）のＥのセルに
　本日の日付を入れたい。

(3)Ｂｏｏｋ2（コピー先ファイル）のＦにも
　本日の日付を入れたい。

(4)マクロ終了後、カーソルは、Ｂｏｏｋ2（コピー先のファイル）
　のＧのセルに置いておきたい。

【補足】
抽出されるデータは一行のみです。

日中、上記の作業を手作業で繰り返していると、
頭がむず痒くなってくるもので、
何か良い方法はないものかと質問させていただきました。
以上、よろしくお願いいたします。

回答No.1

hige_082 · ベストアンサー

＞類似質問を検索してみたものの、初心者のためアレンジがきかず・・・
＞他力本願な質問になり、
＞日中、上記の作業を手作業で繰り返していると、
＞頭がむず痒くなってくるもので、
こういう書き込みはしない方がよいですよ
よく考えてください、勉強もしない、やる気も無い人に
赤の他人がアドバイスすると思いますか？

質問も中途半端
＞以下のマクロを、自動記録でやろうとすると、うまくいきません。
何処がうまく行かないの？
やりたい事を書くのはよいが、マクロの質問なら
Excelのバージョン、コピー元、先のシート名
抽出もマクロでやるなら
どの列どのようなデータから何を抽出するのか
表の構成もあると回答がしやすい

Sub test()
Dim Rng As Range
With Workbooks("book1").Worksheets("sheet1")
.Range("a1").AutoFilter Field:=1, Criteria1:="3"
Set Rng = .Range("b2", .Range("b65536").End(xlUp)).SpecialCells(xlCellTypeVisible)
.Cells(Rng.Row, 5).Value = Date
Workbooks("book2").Worksheets("sheet2").Range("b65536").End(xlUp).Offset(1, 4).Value = Date
Rng.Resize(1, 3).Copy Workbooks("book2").Worksheets("sheet2").Range("b65536").End(xlUp).Offset(1)
End With
Workbooks("book2").Worksheets("sheet2").Activate
Range("b65536").End(xlUp).Offset(, 5).Select
End Sub

以上、示されていない所は適当に決めたので
このままでは、希望の結果はでないと思います
自分の環境に合わせてアレンジしてください
これを機に勉強されては如何かと思います
厳しいことを書きましたが、社会人として節度のある書き込みをすれば
識者の有用な回答が複数得られると思います

お礼

hige_082様、はじめまして、こんばんは。
まずは、お詫びをさせてください。
ご指摘の件はごもっともですね、すみませんでした。

にもかかわらず、ご親切にマクロを教えてくださり、
ありがとうございました。
さっそく試してみましたら、希望通りの結果となり、
感激いたしました！

ただ、せっかく教えていただいたこのマクロ、
今回はドンピシャで活用させていただきますが、
今後似たような作業をするさいに、
自分でアレンジできないのは、もったいないなぁ、と思いました。
hige_082様のアドバイスどおり、これを機に勉強をしてみます。

また、質問の仕方などへのアドバイスも、
なるほどなぁと、大変勉強になりました。
どうもありがとうございます。
今後ともぜひ、よろしくお願いいたします。