エクセル フィルタをかけたセルに貼り付け

質問

お世話になります。
エクセルのシートでフィルタをかけたセルの、選択した範囲のみをコピーして、
同じ範囲に値貼り付けしたいのですが、よい方法が浮かびません。

フィルタで表示するセルには、数式（VLOOKUP）が入っていて、別シートの値を参照しています。
元データが変更されると、数式で表示されている値も変わってしまうので、
VLOOKUPで引っ張ってきた後に、値貼り付けをして、値を確定させたいのです。

フィルタをかけたセルへのコピーは、マクロを使わないとできないことは分かったのですが、
実際にマクロを組むことができず困っています。
助けていただけませんでしょうか。

-----------------------------------------------------
参考として、現在次のようなフォームを使い、生産・販売・在庫の管理をしています。

　　A　　　　　B　　　　C　　　D　　　E　　　F　　　G　　　　H　　　　I
1顧客名　製品名　　　　　10/1　10/2　10/3　10/4　10/5　10/6・・・・
2　A社　　　AAA　　生産　　
3　　　　　　　　　　　販売
4　　　　　　　　　　　在庫　
5　B社　　　BBB　　生産
6　　　　　　　　　　　販売
7　　　　　　　　　　　在庫
8　C社　　　CCC　　生産
9　　　　　　　　　　　販売
10　　　　　　　　　　在庫

列は、日付になります。
行は、製品ごとの生産、販売、在庫が入ります。
在庫行は、「生産数-販売数」の数式が入っています。
生産行は、依頼先から送られてくる生産実績ファイルをもとに、VLOOKUPで参照しています。
フィルタで「生産」だけを表示し、任意の範囲をコピー⇒値貼り付けできるようにしたいです。
宜しくお願い致します。

回答No.1

end-u · ベストアンサー

>実際にマクロを組むことができず困っています。
そのような時は、フリーウェアを探してみるのも解決策のひとつです。
『不連続セルの貼付』
http://www.vector.co.jp/soft/win95/business/se448351.html

もっとも、本ケースは[コピー]-[貼り付け]というより『可視セルの数式を値にする』だけなので
目的を絞れば比較的簡易なコードで対応出来そうです。

Sub Test() 'フィルター後、値化したい範囲をまとめて選択して実行
　　Dim rng As Range
　　Dim r　 As Range

　　If TypeName(Selection) <> "Range" Then Exit Sub
　　On Error Resume Next
　　Set rng = Selection.SpecialCells(xlCellTypeVisible)
　　On Error GoTo 0
　　If rng Is Nothing Then Exit Sub
　　For Each r In rng
　　　　r.Value = r.Value
　　Next

　　Set rng = Nothing
End Sub

お礼

フリーウェアの有用な情報を教えていただきありがとうございました。
このようなものもあるのですね。
早速試したところ、動作も早いしうまい具合に使えるかと思ったのですが、
いざ実データで使用しようとすると、途中までしか貼り付けができませんでした。
（2000行以上もある大きいデータだからか、データに問題があるのかもしれません・・・）

ですが作っていただいたコードで試したところ、多少の待ち時間はあるものの、エラーもなく値貼付けを行うことができました。
数式を値貼り付けする機会がたびたびあるもので、コードを作っていただき大変助かりました。
もうしばらく実データで使用してみて、確認したいと思います。