エクセルのリンク先のフルパスをコピペしたい

質問

先日ここでファイルのフルパスをVBAで探しに行くコードを教えてもらって使い始めたのですが、すでに張ってあるハイパリンクのフルパスをコピーして隣のセルにVBAで貼り付けたく。

一応マクロの記録で試してみて下記の3行でうまく行くのですがこれをループにできません。
宜しくお願いします。

リンクの張ってあるセルはE列でフルパスを貼り付けたいセルは隣のF列です。
尚、対象セルは現在1500個程度ですが逐次増えるので、もし範囲指定しないと非常に時間がかかるようなら10000個（行）でお願いします。
原則空白行は無いのですが，リンクが切れていたり、リンク先のファイルが無いケースは存在します。

Sub リンクのコピペ()
Range("E8").Select
ActiveSheet.PasteSpecial Format:="Unicode テキスト", Link:=False, _
DisplayAsIcon:=False, NoHTMLFormatting:=True

End Sub

回答No.1

HohoPapa · ベストアンサー

Sub SetLink()
Dim RowCnt As Long
RowCnt = 2 '設定開始行番号
On Error Resume Next
Do
If Cells(RowCnt, 5).Value = "" Then Exit Do
Cells(RowCnt, 6).Value = Cells(RowCnt, 5).Hyperlinks(1).Address
RowCnt = RowCnt + 1
Loop
On Error GoTo 0
End Sub

これでいかがでしょうか。

お礼

毎度です。

金曜日にリンクの切れていた140件分は手作業でフルパスをコピペしたのですが、やるなら全部同じ方法でリンクが開けるようにしたいと思いだしHohoPapaさんが見つけてくれることを期待しての質問でした。

コードのコピペからVBAでの処理完了まで1分程度で1500行分が終わりました。（VBAは数秒で終わりました）
尚、開始行は3行目で、D列のフルパスをE列にペーストでした。
コードが分るように書かれているので、実行前に気付いて修正できました。
リンク無しは空白で問題無く処理完了しました。

あっけ無さ過ぎてうれしくもあり、毎度のおんぶにだっこで申し訳なくもあり。

本当に毎度ありがとうございます。