マクロ VB データ一覧表を元に別のシートにそれぞれの内容をコピーまたは複写する方法

Question

初めてマクロを勉強しているものですが、
あるシートから別のシートへの複数コピーの仕方が分からないため
教えていただけますでしょうか。

###前提・実現したいこと
１、現在の状況としては「データ一覧」というデータの一覧(国名)を表にしたシートがあり、
以下のように「国名」、「略称」、「備考」のデータがあります。

２、そしてこの表の略称と一致するシートがあり、
それぞれ以下のようなフォーマットが用意されています。

(※実際に作りたいデータでは、一覧データと同じフォーマットではなく、
もう少し詳細内容が追加されています）

３、ここからが問題なのですが、やりたいこととしては一覧テーブルに「国名」と「備考」が入っているものは
それに対応するシートのフォーマットにも同じように「国名」と「備考」が表示されるようにしたいということです。
(例)略称が[USJ]の場合
⇒[USJ]シートの「国名」に「アメリカ」、「備考」に「留学した」

(例)略称が[CAN]の場合
⇒[CAN]シートの「国名」に「カナダ」、「備考」は空

このようにマクロを実行したときに一覧テーブルと同様のデータが略称の一致するシートにも
表示されるようにしたいです。

「データ一覧」の「略称」に対して「国名」と「備考」が入力されているときに、
「データ一覧」シートの「略称」と一致するシートを選択し、その「国名」と「備考」をコピーする
にはどのような処理が必要になってくるのでしょうか？

###試したこと
今現在、ここを参考にさせていただき勉強しているのですが、
何をどのように組み合わせていけばよいのかが分かりません。
なんだ！カンタン！Excel塾 やさしいエクセルマクロ講座 ExcelVBA

一番やりたいことを実現できそうなのはこのあたりかなとは思ったのですが、
ここからうまく発展できません。
生徒の成績記録簿を原本コピーで作る

イメージとしては[For Each]で回しながら[If]で「もし略称とシート名が一致するならそのシートを選択」、
さらに[If]を書いて「もしデータ一覧に国名、または略称、あるいは両方が入力されているなら、略称の一致するシートのB5に国名を入力し、B6に備考を入力」みたいな感じかな？と思っています。

ためしに備考だけでも出せないかと思い、上であげた生徒の成績記録簿を原本コピーで作るを参考に以下のようなものを書いてみたのですが(本来作成したいマクロではテンプレートのコピー等は行いません)、この場合は[略称]が[JPN]の「備考」の
「母国」が他の国の略称シートの備考に入力されてしましました。

Sub マクロテスト()
  Dim 略称 As Range
  Dim 備考 As Range
  For Each 略称 In Worksheets("データ一覧").Range("B4：B8")
     Worksheets("テンプレート").Copy After:=Worksheets(Worksheets.Count)
     ActiveSheet.Name = 略称.Value
     ActiveSheet.Range("C5") = 略称.Value
     For Each 備考 In Worksheets("データ一覧").Range("C4:C8")
     ActiveSheet.Range("D5") = 備考.Value
     Next 備考
  Next 略称
End Sub

エクセルもろくに使いこなせない中、マクロを使わなければならなくなり勉強しているのですが、
何をどのように進めていけばよいのか分からず悩んでいます。
分からないことだらけで非常に申し訳ないのですが、よろしくお願いいたします。

###追記-その1
皆様ご回答いただきありがとうございます。

昨日に引き続きマクロを勉強しております。
皆様が教えてくださったおかげで完成までのイメージは掴むことができたのですが、
やはり1つ1つできることからやっていってみようと思い、
基本的なところから勉強をやり直しています。

そして今、1つのシートのセルの値をコピーして別のシートに貼り付ける
ということを試しているのですが、調べたとおりにやってみてもエラーが出てしまい
うまくいきません。
何がいけないのかお力添えいただけますでしょうか？

Sub セルコピー貼り付け_その1()
' ワークシートの1つのセルの値をコピーして
' 同じシートの別のセルに貼り付ける場合
'
    Worksheets("データ一覧").Range("B4").Copy
    ActiveSheet.Range("B11").Paste
End Sub

Sub セルコピー貼り付け_その2()
' ワークシートの1つのセルの値をコピーして
' 別のシートのセルに貼り付ける場合
'
    Worksheets("データ一覧").Range("B4").Copy
    Worksheets("USA").Range("B11").Paste
End Sub

ちなみに'Paste'メソッドをつけなくても貼り付けできるという記事をこちらで見たのですが、これも同じくエラーが出ています。
エラー内容は「実行時エラー'438' オブジェクトは、このプロパティまたはメソッドをサポートしていません」、「セルコピー貼り付け_その2()」となっています。

エクセルは2013を利用しています。
よろしくお願いいたします。

(追記1-1)
たびたび申し訳ございません。
こちらのマクロで試してみたところ、うまくコピペすることができました。
このように一個一個分けていかないとだめなのでしょうか？

Sub セルコピペ_その2()
'
' セルをコピーして別のシートに貼り付け
'
    Worksheets("データ一覧").Select
    Range("A4").Select
    Selection.Copy
    Worksheets("USA").Select
    Range("B5").Select
    ActiveSheet.Paste
End Sub

###追記-その2
あともう少しで目指しているマクロができそうなのですが、
またもやわからない部分があるため、追記させてください。

最初に提示させていただいた目標と多少変わったのですが、
「データ一覧」とその他のシートはこのように変更となっております。

「データ一覧」において、略称に対して国名が定義されているものは国名でシートが作成されており、
国名が定義されていないものは略称のままでシートが作成されています。

さらに、略称に対してはハイパーリンクを設定し、
略称と連動しているシートに飛べるようになっています。

最初は、処理の中でIf文を使って、「略称に対して国名がある場合は国名の付いたシートに飛んで値を出力。そうでないものは略称のシートに飛んで値を出力」ということを行っていました。

Sub for文_別のシートに値を出力_その1()
' 「データ一覧」シートの「略称」の値を上から順番に取得して、
'  それぞれの略称名と一致するシートに国名と備考を出力
    Dim 略称 As Range
    Dim 略称取得用 As String
    Dim 国名 As String
    For Each 略称 In Worksheets("データ一覧").Range("B4:B8")
        ' 国名が記述されていない場合
        If 略称.Offset(0, -1).Value = 0 Then
            ' String型の変数「略称取得用」にRange型の変数「略称」を代入
            ' これにより「略称」と一致する名前を持つシートの選択が可能となる
            略称取得用 = 略称
            With Worksheets(略称取得用)
                .Range("B5") = 略称.Offset(0, -1).Value
                .Range("D5") = 略称.Offset(0, 1).Value
            End With
        ' 国名が記述されている場合
        Else
            国名 = 略称.Offset(0, -1)
            With Worksheets(国名)
                .Range("B5") = 略称.Offset(0, -1).Value
                .Range("D5") = 略称.Offset(0, 1).Value
            End With
        End If
    Next 略称
End Sub

ですが、ハイパーリンクが設定されていることからもっと簡単に「リンク設定先のシートに値を出力する」
というようにできないか検証した結果、以下のようなマクロになりました。

Sub for文_別のシートに値を出力_その2()
'  ハイパーリンク先を取得してそのシートに「データ一覧」の「国名」と「備考」を出力
'  "Withステートメント"を使って簡略化
    Dim 略称 As Range
    For Each 略称 In Worksheets("データ一覧").Range("B4:B8")
        略称.Hyperlinks(1).Follow
        With ActiveSheet
            .Range("B5") = 略称.Offset(0, -1).Value
            .Range("D5") = 略称.Offset(0, 1).Value
        End With
    Next 略称
End Sub

これによりやりたいことはほぼ実現できたのですが、
現在の状況としてはセルの範囲を固定しています。

これを「値のある範囲まで」"For Each文"で検索するにはどのようにしたらよろしいでしょうか？

結果としては【B4～B8】までの略称が入っているところまでということで同じになるとは思うのですが、
今後データが追加された際、そのたびにマクロの適用される範囲を修正する必要があるため、
ここを動的に処理してくれるようにしたいです。

参考①
参考②
参考③
参考④

これらを参考にマクロを以下のように書き換えてみたのですが、
こうすると[略称.Hyperlinks(1).Follow]の位置で
「インデックスが有効範囲にありません」とエラーが起きてしまいます。

Sub for文を使った値の取得()
'  ハイパーリンク先を取得してそのシートに「データ一覧」の「国名」と「備考」を出力
'  "Withステートメント"を使って簡略化
    Dim 略称 As Range
    ' セルの範囲を値のある範囲までとしたい
    For Each 略称 In Worksheets("データ一覧").Range("B4", Cells(Rows.Count, 1).End(xlUp))
        略称.Hyperlinks(1).Follow
        With ActiveSheet
            .Range("B5") = 略称.Offset(0, -1).Value
            .Range("D5") = 略称.Offset(0, 1).Value
        End With
    Next 略称
End Sub

デバッグを行うと[Cells(Rows.Count, 1)]のところが[Rows.Count=1048576]で、
[End(xlUp)]が[xlUp=-4162]となっているようで、明らかに値があるところ以外を見てしまっています。

そのため上にあげたエラーが出てしまっているのかと思いますが、
どのようにして解決したらよろしいでしょうか？

よろしくお願いいたします。

Answer 1

[略称]が[JPN]の「備考」の「母国」が他の国の略称シートの備考に入力されてしましました。

こうなってしまった原因は、備考のループ処理で何も条件判定していないので、単純にループの最後の値が残ったためですね

For Each 備考 In Worksheets("データ一覧").Range("C4:C8")
  ActiveSheet.Range("D5") = 備考.Value 'ここで上書きされていくので最後だけ残る
Next 備考

やりたいことに対しての処理のヒントですが

データ一覧の略称名に対し、シートが１：１で過不足なく存在しているなら簡単です

・「データ一覧」の略称の列を頭から順番に処理します
・処理対象の略称名セルに対し、その前のセルにある国名はOffset(0,-1)で参照できます
・同様に略称名セルの後ろにある国名はOffset(0,1)で参照できます
・略称名シートの目標セルに国名と備考をコピーします

やり方は本当にいくらでもありますので、これが正解ということではないです

略称と同じシートが見つからない場合、データ一覧の行数が不定場合、など、エラーになるケースの対応もいずれ必要になるでしょうか

がんばってください

Comments

[riorio]

ご回答いただきありがとうございます。

"こうなってしまった原因は、備考のループ処理で何も条件判定していないので、単純にループの最後の値が残ったためですね"

理解できました。
確かにこれでは思っている値ではなく、ループの最後の値だけが表示されてしまいますね、、、。
ご教授いただきありがとうございます！

"
やりたいことに対しての処理のヒントですが
データ一覧の略称名に対し、シートが１：１で過不足なく存在しているなら簡単です

・「データ一覧」の略称の列を頭から順番に処理します
・処理対象の略称名セルに対し、その前のセルにある国名はOffset(0,-1)で参照できま> す
・同様に略称名セルの後ろにある国名はOffset(0,1)で参照できます
・略称名シートの目標セルに国名と備考をコピーします
"

このように考えていけばよいのですね。
ひとつずつ自分の力で確認して行ってみたいと思います。

応援いただきありがとうございます！
がんばります！！
(なぜかマークダウンで引用が表示されず見づらくなってしまい申し訳ございません)

Answer 2

ちょっと修正してみました。
データ一覧シートのマクロに下記を設置してください。
融通が利くように１セルずつコピーしています。
罫線などの体裁は何もしていません。

Sub マクロテスト()
    Dim r, r2 As Long
    r = 4
    While Cells(r, 2) <> ""
        r2 = 5
        With Worksheets(Cells(r, 2).Text)
            While .Cells(r2, 2) <> ""
                r2 = r2 + 1
            Wend
            .Cells(r2, 2) = Cells(r, 1) ' 国名
            .Cells(r2, 3) = Cells(r, 2) ' 略称
            .Cells(r2, 4) = Cells(r, 3) ' 備考
        End With
        r = r + 1
    Wend
End Sub

Comments

[riorio]

ご回答いただきありがとうございます。

期待する処理が行われました！
ありがとうございます！！

ただ、私が勉強不足であるため、これがどのような処理になっていて、どのように実行されているのか理解するにいたっていないので、
自分で意味を理解できるようにしたいと思います。

本当にありがとうございました！

[ttyp03]

たいしたことはやってないので直ぐに理解できると思いますが、不明なところがあれば聞いてください。
他の方もおっしゃっていますが、やり方はいくらでもあるので、ひとつの参考としてください。

Answer 3

回答が長くなってしまったので、別枠で回答させていただきます。
なお、当初の質問から（同じ命題ではありますが）内容が変わってきていますので、次からは質問を立て直すことをお勧めします。

追記２に関して

原因追及の前に行っている処理の意味を説明します。まわりくどいようで申し訳ありません。

まずRows.Countという値ですが、これはシート上に存在する行数を意味します。
1048576という値は最終行番号（Excelシートで扱える最大行番号）です。

次にxlUpですが、これはExcelのVBAの中で扱える定数です。
-4162という値は行番号ではなく、xlUpが指定されたことを判別するための定数値でしかありません。

Excelシート上でCtrl+↓とかCtrl+↑の操作をしたことはありますでしょうか？
例えばCtrl+↓では現在のセル位置から下方向に、データの区切りまで移動します。
（空欄から入力すれば次にデータがあるセルまで、データのある行で入力すれば連続するデータの終わりまで移動）

Cells(Rows.Count, 1).End(xlUp)
が行っているのがまさにこの処理で、Cells(Rows.Count, 1)からCtrl+↑を実行した位置を取得しています。
つまり、最終行から上方向に向かってデータがある位置を探しているわけです。

エラー原因

問題があるのは
Cells(Rows.Count, 1).End(xlUp)
の1の部分だと思います。

A列の最終行から上方向にデータがあるセルを探している為、見つけるセルはA8になります。
結果、For Eachの範囲はB4:A8となり、A列のセルも略称として取得されることになります。

発生しているエラーは、「ハイパーリンクのないA列のセルを対象に.Hyperlink.Followしようとした」というものではないでしょうか？

デバッグ実行中に略称.Rowと略称.Columnの値を確認すれば、対象としているセル位置がわかると思いますのでご確認ください。

Comments

[riorio]

> 当初の質問から（同じ命題ではありますが）内容が変わってきていますので、次からは> 質問を立て直すことをお勧めします。

すみません、どうしようか悩んだのですがここの流れの中でお話した方が始めてくる方も理解しやすいかと思い、そのままこちらに書かせていただいておりました。
ただや質問内容も回答も長くなり読みづらくなってしまうので、次回からは立て直す用にいたします。

丁寧なご解説ありがとうございます。
ちょうどもう一度参考ページを読み直していて、[Rows.Count]について理解しかけているところでした。
[Cells(Rows.Count, 1).End(xlUp)]の[1]の部分が問題だということで調べなおしてみると、確かにこれだとA列の最終行を取得してしまうのですね、、、。
そこでB列の最終行を取得できるように、

[For Each 略称 In Worksheets("データ一覧").Range("B4", Cells(Rows.Count, 2).End(xlUp))]

と変えてみたのですが、そうすると今度は「アプリケーション定義またはオブジェクト定義のエラーです。」というエラーが出るようになってしまいました。
このエラー内容で検索してみましたが、納得できる答えが見つかりません、、、。
何か書き方を間違えてしまっているということでしょうか？

(追記)
一時間ほど色々試してみてようやくうまくいきました、、、。
[Cells(Rows.Count, 2).End(xlUp)]
の部分を
[Worksheets("データ一覧").Cells(Rows.Count, 2).End(xlUp)]
に修正したところ動きました！
ちゃんとオブジェクトとなるシートを宣言できていませんでした。
同じ一分の中で行っているので、オブジェクトは指定できているとまたもや勝手な機目付けをしてしまっていました。
先入観には気をつけないといけませんね、、、。
お騒がせしてしまい申し訳ございませんでした。

[jawa]

こちらの環境（Win7/Excel2010）で記載いただいたFor文に変更したところ、意図した動きとなりました。
環境の違いでしょうか・・・。

エラーの発生個所はやはり.Followでしょうか？
あと、
・他に変更したコードはないか
・参照したセルに不正なリンクが設定されていないか
というあたりが気になります。

ご確認ください。

[jawa]

すみません、コメントへの追記に気付かず投稿してしまいました。
解決したようで何よりです＾＾

[riorio]

jawaさん
何とか基本的な部分は解決するに至りました。
ありがとうございました！

ただ、今度はまた少し別のパターンで分からないことがございます。
もしよろしければこちらも見ていただけますでしょうか？

https://teratail.com/questions/43301?complete=

よろしくお願いいたします。

Answer 4

まず別案から

検索マスタとなるデータ一覧シートの内容が、以下の条件を満たしていればVBAを使わなくてもVlookupというExcel関数だけで実現可能です。

条件１：検索マスタの左端列が検索キーであること
条件２：検索マスタが検索キーの昇順でソートされていること

今回の場合、略称が検索キーとなり、そこから紐付く名称や備考を探すことになりますので、条件１は満たしていません。
また、略称の昇順で並んでもいませんので、条件２も満たしていません。

もしデータ一覧シートを
A列, B列, C列
BRZL, ブラジル, オリンピック開催される
CAN, カナダ,
JPN, 日本, 母国
MXCO, メキシコ, 遊びに行った
USA, アメリカ, 留学した

のように変更してもよければ、
国名のセルは
=VLOOKUP(C5,データ一覧!A4:C8,2,FALSE)
備考のセルは
=VLOOKUP(C5,データ一覧!A4:C8,3,FALSE)
のような式をセルに記述することで取得できるようになります。

既存コードの改善案

データ一覧シートを変更できない場合はVBAで処理することになります。

掲載いただいたコードは、
①データ一覧をループ処理
② テンプレートシートからのコピーで新規にシートを作成
③ データ一覧の略称をシート名に設定
④ データ一覧の略称をコピーシートの略称欄に入力
⑤ さらにデータ一覧をループ処理
⑥ データ一覧の備考をコピーシートの備考欄に入力
⑦ データ一覧の行数分⑤ループを繰り返す
⑧データ一覧の行数分①ループを繰り返す

という処理になっています。

問題がありそうなのは⑤からのループ部分で、略称が一致しているかに関わらず備考欄の複写を繰り返しています。
このため、データ一覧の最終行である母国がどのシートにも設定されることになります。

略称を検索して紐付く国名・備考を取得したいのであれば、略称が一致しているかどうかの判定文を追加する必要があります。

Sub マクロテスト()
    Dim 略称 As Range
    Dim 検索 As Range
    
    For Each 略称 In Worksheets("データ一覧").Range("B4：B8")
        Worksheets("テンプレート").Copy After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = 略称.Value
        ActiveSheet.Range("C5") = 略称.Value
        
        '検索ループ
        For Each 検索 In Worksheets("データ一覧").Range("B4:B8")
            '検索セルと略称が一致しているか？
            If 検索.Value = 略称.Value Then
                '同名のセルが見つかれば複写して検索ループを抜ける
                ActiveSheet.Range("B5") = Worksheets("データ一覧").Cells(検索.Row, 1)
                ActiveSheet.Range("D5") = Worksheets("データ一覧").Cells(検索.Row, 3)
                Exit For
            End If
        Next 検索
    Next 略称
End Sub

ただし、今回の場合はもともとデータ一覧シートを元にシート作成していますので、検索の必要自体がありません。
略称もそのまま複写していますよね。
同じ行から国名と備考も複写してあげればいいと思います。

Sub マクロテスト()
    Dim 略称 As Range
    Dim 備考 As Range
    Dim iRow as Integer
    
    For Each 略称 In Worksheets("データ一覧").Range("B4：B8")
        Worksheets("テンプレート").Copy After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = 略称.Value
        ActiveSheet.Range("C5") = 略称.Value
        
        '略称セルの行番号を取得
        iRow = 略称.Row
        
        '略称と同じ行から国名・備考を複写
        ActiveSheet.Range("B5") = Worksheets("データ一覧").Cells(略称.Row, 1)   '国名を複写
        ActiveSheet.Range("D5") = Worksheets("データ一覧").Cells(略称.Row, 3)   '備考を複写
        
    Next 略称
End Sub

追記に関して

まとめて書いているコードを分解してあげると原因が掴みやすくなりますよ。

エラーとなるコードを以下のように分解して、デバッグ実行(F8)で1行ずつ処理を追ってみましょう。
どこでエラーになりましたか？

Sub セルコピー貼り付け_その2()

   'Worksheets("データ一覧").Range("B4").Copy
   'Worksheets("USA").Range("B11").Paste

    Dim sht1 As Worksheet
    Dim sht2 As Worksheet

    Dim rng1 As Range
    Dim rng2 As Range

    Set sht1 = Worksheets("データ一覧")
    Set sht2 = Worksheets("USA")

    Set rng1 = sht1.Range("B4")
    Set rng2 = sht2.Range("B11")

    rng1.Copy
    rng2.Paste
    
End Sub

デバッグ実行するとわかると思いますが、エラーになるのはPasteしている部分です。
Range型にはPasteメソッドは用意されていません。

Copy&Pasteで実行するなら

    rng1.Copy
    sht2.Paste Destination:=rng2

のような感じになります。

ただ、Copy&Pasteはクリップボードを上書きしてしまうので個人的にはあまりお勧めしません。

'Paste'メソッドをつけなくても貼り付けできるという記事

で紹介されている方法

    rng1.Copy rng2

では、クリップボードを使用せず、セルの値を複写することができます。
⇒　間違いでした。Pasteの記述を省略して一行化できるだけでクリップボードは使用されます。

クリップボードを使用しない方法は、セルの値だけのコピーでよければ

    rng.Value = rng1.Value

で実現できます。

書式や色もコピーしたい、となると、Value以外のプロパティもそれぞれ写してあげる必要があります。

Comments

[riorio]

ご回答いただきありがとうございます。

非常に分かりやすい解説で理解することができました！
ありがとうございます！
今回の場合は、DB設計書を作成しているため、関数だと設計書の修正のたびに定義しなおさなければいけないという理由で、マクロを採用しておりますので、jawa様含め皆様にご教授いただいたやり方を活かしてマクロの作成を進めていきたいと思います。

丁寧なご回答ありがとうございました。

[riorio]

追記に関して早速のご回答ありがとうございます。

>Range型にはPasteメソッドは用意されていません。
エラー内容に「実行時エラー'438' オブジェクトは、このプロパティまたはメソッドをサポートしていません」と出ているのに気が付きませんでした、、、。
さくっとこちら(http://excel-ubara.com/EXCEL/EXCEL906.html)で調べてみて、「あれ、なんで'Pasteメソッド'出てないんだろう。おかしいなあ。」というように、あるはずなのにないという先入観を持ってしまっていました。
ご指摘いただきありがとうございます！

>ただ、Copy&Pasteはクリップボードを上書きしてしまうので個人的にはあまりお勧めしません。

お恥ずかしながらクリップボードの存在を初めて知りました。エクセルにはこんな機能もあるのですね。
たしかにクリップボードに保存しておきたいものがあるときに、Copy&Pasteマクロを使用するたびにクリップボードに上書きされていってしまうと困りますね。
気をつけます。

何から何まで教えてくださりありがとうございます！！

[jawa]

クリップボードはExcelの機能というよりWindowsの機能ですね。

OfficeのクリップボードダイアログはWindowsのクリップボードと連携・強化したような機能で、過去にカット/コピーしたものをある程度遡って使用できます。
が、他のソフトではそうもいきません。

・開発中のソースコードを他の部分に移そうと切り取った
⇒片手間で作業していたExcelでマクロを実行
⇒切り取った内容を貼り付けようとしたらセルの値が貼りついた＞＜

…みたいな悲劇を幾度も経験していますので、「立つ鳥跡を濁さず」を心がけています(^-^;

[riorio]

エクセルもまだあまり使ったことがないのでイメージがわきませんが、とりあえずそうなってしまうと大変困るということが分かりました、、、。
私も「立つ鳥跡を濁さず」精神を大切にしたいと思います。

また非常に申し訳ないのですが、本日新たに「追記_その2」を更新いたしました。
お忙しい中毎日ご質問にお答えしていただき大変申し訳ないのですが、
今回もご教授願えると幸いです。
よろしくお願いいたします。

Answer 5

VLookUp関数で同じことができそうですが、VBAでないとダメですか？

Comments

[riorio]

ご回答いただきありがとうございます。

VLookUp関数でも同じようなことができそうですね！
ご教授いただきありがとうございます！
ただし今回はマクロを実装する必要があります。

現在DB設計書を作成しているのですが、関数を使った場合DBの設計書に変更があるたびに関数を定義しなおさなければいけないということになります。
そのため、上司からは関数ではなくマクロを実装するように言われています。
そこでマクロを勉強しているという状況です。

説明不足で大変申し訳ございません。

Answer 6

(追記2-1)に対して
jawaさんはじめ、皆さんのお力添えのおかげで、
このマクロによりやりたいことが実現できました。

Sub for文_別のシートに値を出力_その4()
'  ハイパーリンク先を取得してそのシートに「データ一覧」の「国名」と「備考」を出力
'  "Withステートメント"を使って簡略化
    Dim 備考取得 As Range
    Dim 略称 As Range
    For Each 備考取得 In Worksheets("備考記入").Range("A6", Worksheets("備考記入").Cells(Rows.Count, 1).End(xlUp))
        For Each 略称 In Worksheets("データ一覧").Range("B4", Worksheets("データ一覧").Cells(Rows.Count, 2).End(xlUp))
            If 略称.Value = 備考取得.Value Then
                略称.Offset(0, 1).Value = 備考取得.Offset(0, 1).Value
                略称.Hyperlinks(1).Follow
                With ActiveSheet
                    .Range("B5") = 略称.Offset(0, -1).Value
                    .Range("D5") = 略称.Offset(0, 1).Value
                End With
                Exit For
            End If
        Next 略称
    Next 備考取得
End Sub

長文にお付き合いいただき本当にありがとうございました。
おそらくまた質問を立てさせていただくことも多いかと思います。
その際はどうぞよろしくお願いいたします。

Comments

[riorio]

みなさん、本当にありがとうございました！
ここで、自己解決とするとベストアンサーを選出できないのですね、、、。
申し訳ございません。