エクセルで特定の複数セルを選択し、別ブックへ一度に「リンク貼り付け」するマクロは？

質問

エクセルで作成したファイル(1)で、特定の複数セル（連続していないセル）を選択し、まったく同じフォーマットの別ふぁいる(2)へ一度に「リンク貼り付け」する方法があれば教えて頂きたいと思っております。

【BOOK(1) － シート】をコピー
---------------------------------------------------------------- ----------------------
　 A　　 　B C 　　 　　D　　 　　E FG　　　H　

1 NO 　　 名前　　　ランク　　概要　 　 備考

2　11　　　あああ　 　 　 A 　　 　****　　　○○○　

3　55 　 　 いいい 　 　 B 　　　 ****　　　△△△　　

4　77 　　　ううう 　　　 C 　　　 ****　　　□□□　　　　
---------------------------------------------------------------- ----------------------

【BOOK(2) － シート】へリンク貼り付け
---------------------------------------------------------------- ----------------------
　 A　　 　B C 　　　 　D　　 　 　E FG　　　H　

1 NO 　　 名前　　　ランク　　概要　 　 備考

2　11　　　あああ　 　 　　 　　 ****　　

3　

4　　 　　　 ううう 　　　 C 　　　
---------------------------------------------------------------- ----------------------

列BとC、列EとFとGはセルの結合をしております。
BOOK(1)のセル「A2」「BC2」「BC4」「D4」「EFG2」だけをコピーし、
BOOK(2)の同一セルへリンク貼り付けを行う。
コピーするセルが飛び石のように離れており、2つ以上のセルが結合している列があったりします。
複数のBOOKがあり、すべてのBOOKで上記と同一セルを「リンク貼り付け」する場合に
一度にまとめて実行できるようなＶＢＡやマクロで実現可能な方法があれば教えて下さい。
（勉強も兼ねているため、マクロ記述に補足説明があると助かります）
現在の所、連続しているセルはまとめてリンク貼り付けができるのですが、離れているセルは１つずつ選択して貼り付けております。
この別ファイルへのリンク貼り付け作業が大量にあり、時間がかかるため大変困っております。
御手数お掛け致しますが、何卒よろしくお願いいたします。

回答No.1

mt2008

地道に、1ブックづつ開いて、1セルづつリンク貼り付けしてやるしか無い様に思えます。
画面更新を停止すればかなりのスピードアップになりますし、リンク貼り付けを行うセルが決まって居るなら、セル範囲を配列に持てばコードもある程度シンプルに出来ますよ。

以下、サンプルです。
貼り付けるブックを「貼り付けBOOK…」で始まる名称のブックと仮定しています。

Sub Test()
　Dim vTarget As Variant '対象セル情報
　Dim nLoop As Long
　Dim sFile As String

　vTarget = Array("A2", "B2:C2", "B4:C4", "D4", "E2:G2") '対象セル情報を配列に入れる
　Application.ScreenUpdating = False '画面更新停止

　sFile = Dir("貼り付けBOOK*.xls")　'貼り付けるブックを検索
　Do While sFile <> ""
　　Workbooks.Open Filename:=sFile '貼り付けるブックを開く

　　For nLoop = 0 To UBound(vTarget)　'配列分ループを回す
　　　ThisWorkbook.Activate
　　　Worksheets("Sheet1").Range(vTarget(nLoop)).Copy '自ブックの対象セルをコピー

　　　Windows(sFile).Activate
　　　Worksheets("Sheet1").Range(vTarget(nLoop)).Select '貼り付けるブックの対象セルを選択
　　　ActiveSheet.Paste Link:=True　'リンク貼り付け
　　Next nLoop
　　Windows(sFile).Close True '貼り付けるブックを保存終了
　　sFile = Dir() '貼り付けるブックの検索を続行
　Loop
　Application.ScreenUpdating = True '画面更新再開
End Sub

お礼

早々のご回答をありがとうございました。早速、試してみたいと思います。また質問等をさせていただくこともあるかもしれませんが、宜しくお願い致します。

補足

mt2008様
教えていただいたコードを試してみたのですが、別BOOKへのリンク貼り付けができませんでしたので、質問させていただきます。

>>vTarget = Array("A2", "B2:C2", "B4:C4", "D4", "E2:G2") '対象セル情報を配列に入れる

　対象セルの指定についてですが、例えばA1からC10までの連続した広範囲のセルをまとめてリンク貼り付けしたい時の範囲指定の記述は「"A1:C10"」でよろしいですか？
また、B1とC2で結合しているセルの指定は「"B2:C2"」でよろしいでしょうか？

>>sFile = Dir("貼り付けBOOK*.xls")　'貼り付けるブックを検索

　貼り付けるブックを指定する時は、同一階層にあるファイルであればファイル名だけを指定すればよろしいでしょうか？それともフルパスにしますか？
それから、ここではブックの指定のみでシートの指定はしなくてもよいのでしょうか？
　ちなみに、貼り付けするブックは社内ネットワーク上の共有サーバ上にあり、フォルダー名が日付になっており毎月変更されるためフルパスを指定が難しいのですが、フルパスで指定しない方法があれば教えていただけると幸いでございます。
お忙しい所 大変恐縮ではございますが、宜しくお願い致します。