VBA、マクロについて、どなたか知恵をお貸し願います！

VBA独学中の初心者です。
ある問題に躓いており、どうしても動かない部分があるため、皆様のお力添えをいただきたいです。
説明が稚拙で分かりづらいかもしれませんが、宜しくお願いいたします。

① 2つのbook(book1/book2)があるとし、登録したマクロはbook2に設置する。
book2のsheet2に以下のような表を作る。
　※枠線がズレてしまっていますが、それぞれが1つのセルと考えてください。
　　人物・情報と入力されたセルは見出しです。
　　また、1人の人物のデータに対し、その人の情報が3つあるとします。
　　
＿＿＿＿＿＿＿＿＿＿＿＿＿＿
｜人物　　　｜ 　　情報 　　|
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿

｜B君 ｜ 　｜　　｜　 ｜
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
｜C君 　 ｜ ｜ ｜ ｜
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
｜A君 ｜ ｜ ｜ ｜
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿


② book1のsheet3に、同じ表があるとする。ただし、情報のセルは記入されている。
　
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
｜人物　　　｜ 　　情報 　　　　|
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿

｜A君 ｜長男｜中学生｜14歳｜
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
｜B君 　 ｜次男｜小学生｜10歳｜
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
｜C君 ｜長男｜高校生｜16歳｜
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿

③book2に設置しているマクロを実行すると、book1/sheet3のデータを読み込み、book2/sheet2の該当する人物のデータに表示されるようにする。但し、①②をみてわかるように、人物の名前の順番は同じではない。



・・・というものです。
最初に作ったプログラムでは、以下のように考えました。

book1/sheet3のUsedRangeから”A君”という文字列を

Set A君1 = Cells.Find(what:="A君", lookat:=xlPart)
で探し、
Selection.Offset(Columnoffset:=1).Select
で１つとなりのセルをActiveにし、
そのActivecellを"A君情報1"という変数にし、Do loopを使ってbook1/sheet3の"情報"セルがが空白になるまで1つずつ右に移動/変数を設定し、その値をbook2/sheet2の該当セルに代入していく・・・・(book2/sheet2の表からも、同じ工程で"A君"を探し、隣のセルに変数を設定する)というものです。そして、C君までの情報を全て出力し終えるというプログラムを作りたいのです。

ちなみに、book2からbook1の呼び出しはできました。

以下が作ってみたプログラムです。↓
・
・
・
・
'型があっていないとエラーになるため、とりあえずすべてVariant型にしています
Dim SorceFile As Variant, OpenFile As Variant
Dim A君1 As Variant, B君1　As Variant, C君1 As Variant
Dim A君情報1 As Variant, B君情報1 As Variant, C君情報1 As Variant
Dim A君情報2 As Variant, B君情報2 As Variant, C君情報2 As Variant

'現在開いているbook2の名前をSorceFileという変数にする
Set SorceFile = ThisWorkbook
'ファイル(book1)を選択して開く
OpenFile = Application.GetOpenFilename
If OpenFile <> fales Then
Filename = Dir(OpenFile)
MsgBox Filename
Workbooks.Open OpenFile
Else
MsgBox "キャンセルされました"
End If

'開いたファイル(book1)から、"A君"という文字列を探す。見つかったら、1つ隣のセルに移動し、"A君情報1"という変数を設定する。
ActiveSheet.UsedRange.Select
Set A君1 = Cells.Find(what:="A君", lookat:=xlPart)
A君1.Select
A君1.Offset(columnoffset:=1).Select
A君情報1 = ActiveCell

'マクロが設置されているbook2をアクティブにし、同様に"A君"という文字列を探す。見つかったら、1つ隣のセル(空白)に移動し、その空白のセルに"A君情報2"という変数を設定する。
ThisWorkbook.Activate
ActiveSheet.UsedRange.Select
Set A君2 = Cells.Find(what:="A君", lookat:=xlPart)
A君2.Select
A君2.Offset(columnoffset:=1).Select
A君情報2 = ActiveCell




・・・と、ここまではステップインをしながら変数の値を確認できています。、
このあとbook2の空白のセル"A君情報2"にbook1の"A君情報1"の値を代入したいのですが、

ThisWorkbook.Worksheets("sheet2").A君情報2.value = Workbooks(SorceFile).Worksheet("sheet1").A君情報1.value

↑ではコンパイルエラーになります。book2の表、A君の空白の情報で"長男"～"14歳"まで、book1から抽出/出力ができたら、次はB君C君・・・としていきたいのですが、「型が一致しない」や「インデックスが有効範囲にありません」となってしまいます。
この値だけ代入することができれば、私の力でもプログラムを最後まで作成することができるのですが・・・

分かりづらく、しかも玄人の方からすれば何だこのマクロは！！となるかもしれませんが、
どうかアドバイスの程、宜しくお願いいたします。

No.3 ベストアンサー 回答者： WindFaller 回答日時： 2017/08/10 00:55

こんばんは。

要するに、ソースファイル（データファイル）から情報を取り出す内容なのですね。
それをあえてFind メソッド指定なのかな？

>ActiveSheet.UsedRange.Select
だったら、以下は、Cells ではなくて、Selection でしょうね。

> Cells.Find(what:="A君", lookat:=xlPart)
なぜ、xlPart になっているのでしょうか？表記の乱れがあるということでしょうか？
変数の使い方とか、初歩的なところがまだ出来ていません。

>玄人の方からすれば何だこのマクロは
Findメソッド は、常連さんの某氏の専売特許のようなものですが、私だと、配列からMatch関数を利用しいるのだろうとは思います。玄人的なら、ADODBでしょう。ファイルを直接開けないで可能だからです。もちろん、Excel関数での処理もありますが、あまり格好がよくありません。

私が書くと、こんなコードにしてしまいます。

person　info1　info2　info3
A君　長男　中学生　14歳
B君　次男　小学生　10歳
C君　長男　高校生　16歳
D君　三男　大学生　18歳 * 新たな情報が加わった場合も、D君のものだけを取るようにしています。

一旦取得した後に、D君の資料を取り寄せる
B君　次男　小学生　10歳
C君　長男　高校生　16歳
A君　長男　中学生　14歳　
D君　



'//標準モジュール
Sub GetDataAll()
　Dim wb1 As Workbook　'データのソースファイル
　Dim AcSh As Worksheet　'アクティブシート（データを受け取る側）
　Dim c As Range
　Dim r As Range
　Dim startRw As Long　'検索文字列の最初の行
　Dim FindArea As Range　'データ・ソースの被検索場所
　Const FNAME As String = "myDATABook.xlsx"　'Thisbook と同フォルダーのファイル名
　Set AcSh = ThisWorkbook.Worksheets("Sheet2")
　
　On Error GoTo ErrHandler
　Set wb1 = Workbooks(FNAME)　'オブジェクトとして認識できるか？できなければ、ErrHandlerに飛ぶ
　
　Set FindArea = wb1.Worksheets("Sheet1").Columns(1)　'ソースファイルの1列目を検索
　With AcSh
　　Application.Goto AcSh.Range("A1") 'データをインポートするシートに戻る

　　'データに空きがないか調べ、データ検索の初期値の行を求める
　　If .Cells(Rows.Count, 1).End(xlUp).Row > .Cells(Rows.Count, _
　　　　2).End(xlUp).Row Then
　　　 startRw = .Cells(Rows.Count, 2).End(xlUp).Row + 1
　　Else
　　　 MsgBox "データの取得の必要がありません。", vbExclamation
　　　 Exit Sub
　　End If
　　
　　'単語検索は、ワイルドカードを加える, c.Value & "*" ->LookAt:=xlWhole となる
　　For Each c In .Range(.Cells(startRw, 1), .Cells(Rows.Count, 1).End(xlUp))
　　　If c.Value <> "" Then
　　　　Set r = FindArea.Find(What:=c.Value & "*", LookIn:=xlValues, _
　　　　　　LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, _
　　　　　　MatchByte:=False)
　　　　If Not r Is Nothing Then
　　　　　'配列の受け渡し（非推奨）
　　　　　c.Offset(, 1).Resize(, 3).Value = r.Offset(, 1).Resize(, 3).Value
　　　　End If
　　　End If
　　Next
　End With
　Exit Sub
ErrHandler:
　'エラーの発生の場合
　If Err.Number = 9 Then
　　If Dir(FNAME) <> "" Then
　　　Workbooks.Open FNAME
　　　Resume 'エラーを発生した所まで戻る
　　Else
　　　MsgBox "ファイルが見つからないか、パスを指定してください。", vbExclamation
　　　Exit Sub
　　End If
　Else
　　MsgBox Err.Number & " :" & Err.Description & " :" & Erl
　End If
End Sub

'//

　'配列の受け渡し
　c.Offset(, 1).Resize(, 3).Value = r.Offset(, 1).Resize(, 3).Value

入門・初級レベルでは、Copy メソッドのほうが良いでしょう。
r.Offset(, 1).Resize(, 3).Copy c.Offset(, 1)

この回答へのお礼

お礼が遅くなり、大変申し訳御座いません！
回答いただき有り難う御座いました！

あまりにも高度すぎて、自分のプログラムの稚拙さに恥ずかしさを覚えました(汗)
やはり、まだまだ勉強が必要ですね・・・確かに、copyメソッドの方が今後使用しやすそうです！！
コードを書いていただき、ベストアンサーに選ばせて頂きました。

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

お礼日時：2017/08/19 15:10

No.2 回答者： t_fumiaki 回答日時： 2017/08/08 20:38

A君情報2.value → Range(A君情報2).Value

A君情報1.value → Range(A君情報1).Value
Workbooks(SorceFile). → SorceFile.
Worksheet("sheet1"). → Worksheets("sheet1").

纏めると以下
ThisWorkbook.Worksheets("sheet2").Range(A君情報2).Value = SorceFile.Worksheets("sheet1").Range(A君情報1).Value

この回答へのお礼

お礼が遅くなり、大変申し訳御座いません！
回答いただき有り難う御座いました！

いただいた回答を参考にプログラムを見直したところ、なんとか動かすことができました！！
プロパティやメソッドの使い方をもう一度勉強し直す必要がありそうです。
本当にありがとうございました！！

お礼日時：2017/08/19 15:06

No.1 回答者： t_fumiaki 回答日時： 2017/08/08 16:32

ThisWorkbook.Worksheets("sheet2").Range(A君情報2).value = Workbooks(

SorceFile).Worksheet("sheet1").Range(A君情報1).value

この回答へのお礼

お礼が遅くなり、大変申し訳御座いません！
回答いただき有り難う御座いました！

いただいた回答を参考にプログラムを見直したところ、なんとか動かすことができました！！
本当にありがとうございました♪

お礼日時：2017/08/19 15:04