excel マクロコードを教えていただきたいです

質問

マクロ初心者のため、単純な動作しか分からず困っています。
以下の表とマクロコードを確認していただき、教えていただきたいです。

ファイル【Book1】の表

　　A　　B　　C　　D　　E　　F　　 G　　
1　　　　　　　　　　　　　　　　　　data1　　　ボタン1　　
2　　　　　　　　　　　　　　　　　　data2　　　ボタン2　
3　　　　　　　　　　　　　　　　　　data3　　　ボタン3　　　　
4　　　　　　　　　　　　　　　　　　data4　　　ボタン4　
5　　　　　　　　　　　　　　　　　　data5　　　ボタン5　
6　　　　　　　　　　　　　　　　　　data6　　　ボタン6　
・　　　　　　　　　　　　　　　　　　　・
・　　　　　　　　　　　　　　　　　　　・
・　　　　　　　　　　　　　　　　　　　・

※Gの列にはハイパーリンクが並んでいます。
※ハイパーリンクにて各ファイル（data1・data2・data3・・・・）が開きます。
※各行の右端にはフォームのボタンを設置しています。

∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞
Sub Macro1()
Range("G1").Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Windows("Book1.xls").Activate
Range("A1:F1").Select
Selection.Copy
Windows("data1.xls").Activate
ActiveSheet.Paste
End Sub
∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞∞

今の動作としては、ボタン1を押す事でファイル”Book1”のG1のハイパーリンク（data1.xls）が開き、
”Book1”のA1からF1をコピーして、data1のsheetに貼り付けています。
これで、当初は5行ぐらいの表でしたので、毎回、上記の行番号を変更したコードを入力し、各ボタンに
登録していました。ただ今後、この表の行が多くなるとの事で、毎回、この作業を行うわけにもいかず、
何か良い案（マクロ）があれば教えていただきたいです。
やりたい事としては、マクロの実行にて、ハイパーリンクが立ち上がりその行の内容を、その立ち上がった
ファイルのsheet2のセルA1:F1に貼り付けたいと思っています。
例としては、立ち上げたい行(セル)をクリックしておいて、ボタンを押すと上記のマクロが開始するなど・・・。
出来もしないのに生意気で申し訳ありませんが、教えていただけると助かります。よろしくお願い致します。

回答No.1

SePapa · ベストアンサー

こんにちは。

ボタンは一つにし、ボタン実行時に
以下のマクロ実行すれば可能です。

***************************
Sub Macro1()
Dim col As Integer '選択行No取得用変数

Windows("Book1.xls").Activate
col = ActiveCell.Row '現在選択している行No格納
Range(Cells(col, 1), Cells(col, 6)).Select '該当行のA～F列選択
Selection.Copy '選択範囲コピー

Cells(col, 7).Hyperlinks(1).Follow NewWindow:=True '該当行のリンク開く
Range("a1").Select '貼り付けセルの選択
ActiveSheet.Paste '貼り付け

End Sub
***************

ボタン押下時に選択しているセルの行番号を取得し
その行のＡ～Ｆ列をコピーして
はりつけるというものです。

一度お試しください。

お礼

上記コードにて確認させていただきました。思い通りの動作になっていて感心しました。大変ありがとうございます。また機会がありましたらぜひ教えてください。よろしくお願いします。

回答No.4

Wendy02

こんにちは。

たぶん、Excel 2002 以上だと思いますが、それ以下だったら、コードの内容が変わりますから、注意が必要です。それから、本来、ブックを開くためのハイパーリンクは、私は、あまり関心しせません。どうやら、その状況によっては、二度、Activate イベントが働いているようです。一度目は、キャッシュを探し、次に、ファイルを探すということをしています。

その状態ではハイパーリンクは生きていないはずですが、そのハイパーリンクを使おうとすると、VBAは、命令待ち状態になるのではないでしょうか？だからといって、それでコマンドボタンを付けるというのも考え物です。

一定のフォルダなら、単にブック名だけでよいと思います。それを、ダブルクリック・イベントに結びつければよいわけです。もし、長いファイル名などは、隠し列にしてしまい、ブック名だけを出しておいて、以下の、Target を、右となりを探す場合なら、Target.Offcet(,1).Value などとすればよいです。

'シートモジュール

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　　Dim r As Range
　　Cancel = True
　　If Not Target.Value Like "*.xl*" Then Exit Sub
　　Set r = Range("A1:F1")
　　On Error GoTo ErrHandler
　　With Workbooks.Open(Target.Value)
　　　　r.Copy .Worksheets("Sheet2").Range("A1")
　　End With
ErrHandler:
　　Set r = Nothing
End Sub

回答No.3

web2525

前回の続きですねｗ

ポイント:
質問のマクロの
Range("A1:F1").Select
Selection.Copy
この動作はハイパーリンクで飛ぶ前に実行すると、目的のBOOKが開いた後に
Windows("Book1.xls").Activate
でいちいち戻ることなく、ハイパーリンクで飛んだ状態で
Sheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste
実行でそのまま貼り付け可能です。
そうすると
Windows("data1.xls").Activate
飛び先のBOOK名を入力する必要がなくなるので、マクロ自体を作り変えることなく1つのマクロを流用することが出来ます。
（前回の解答もそのつもりで作ったんですけどね）

実際のマクロは既に回答が出てるようなので解説のみで。

お礼

何度も投稿していただきありがとうございます。前回の内容を私の実力では把握できておらず申し訳ありませんでした。また機会がありましたら教えていただきたいです。よろしくお願いします。

回答No.2

xls88

色々やり方はあるかと思いますが、現状のスタイルに合わせてみました。

Application.Caller
で、クリックされたボタンの名前を取得
そのボタンの
TopLeftCell
で、そのボタンの下のセルを取得
取得したセルの隣（G列）が、ハイパーリンクセルかどうか判定して処理
といった流れになっています。

Sub test1()
　　With ActiveSheet.Buttons(Application.Caller).TopLeftCell
　　　　If Cells(.Row, "G").Hyperlinks.Count <> 1 Then
　　　　　　'ハイパーリンクで無ければマクロから抜ける
　　　　　　Exit Sub
　　　　Else
　　　　　　Cells(.Row, "G").Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
　　　　End If
　　　　Workbooks("Book1.xls").Activate
　　　　Range(Cells(.Row, "A"), Cells(.Row, "F")).Copy _
　　　　　　Workbooks(Cells(.Row, "G").Value).Sheets("Sheet2").Range("A1")
　　End With
End Sub

各ボタンに、上記マクロを登録してみてください。
各ボタンのTopLeftCellを使っていますから、ボタンの位置が大事になります。