EXCEL VBAで教えてください。（隣のシートから自動転記の方法）

こんばんは。ＥＸＣＥＬＶＢＡで教えてください。
シート名「Ａ」と「Ｂ」があります。
シート「Ａ」にはＢ２から下に氏名、Ｃ２から下に電話番号が入っています。（約500件）
シート「Ｂ」に名前を入れたときにシート「Ａ」からその人の電話番号が名前を入れた下のセルに自動的に入るようにしたいのです。
byval target as range,find,setなどを使うと思いますがうまく思いつきません。
ご教示よろしくお願い致します。

質問者からの補足コメント

• 

  こんばんは。みなさまご回答ありがとうございます。質問が分かり辛かったかもしれませんが
  シート「Ｂ」のセルの氏名の位置は決まっていません。（バラバラの位置です）ですので一つ一つ関数を入れると手がかかるのでＶＢＡで自動で転記できないかを質問させていただきました。ＶＢＡでできるのでしょうか？

    補足日時：2016/02/17 19:51

• tom04さん、ご教示ありがとうございます。
  範囲はＢ１：ＡＷ８０までです。
  二度手間で申し訳ありません。

  No.4の回答に寄せられた補足コメントです。 補足日時：2016/02/18 05:25

No.5 ベストアンサー 回答者： tom04 回答日時： 2016/02/18 08:27

続けてお邪魔します。

＞範囲はＢ１：ＡＷ８０までです。
というコトですので、↓のコードに変更してみてください。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, wS As Worksheet
Set wS = Worksheets("A")
If Intersect(Target, Range("B1:AW80")) Is Nothing Or Target.Count > 1 Then Exit Sub
With Target
If .Value <> "" Then
Set c = wS.Range("A:A").Find(what:=.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
.Offset(1) = c.Offset(, 1)
End If
End If
End With
End Sub

※　あくまで憶測ですが、
＞名前を入れた下のセルに自動的に入るようにしたい・・・
が最初の質問だったので、
奇数行に入力　→　その下のセルに表示！
がご希望なのでは？
そうであれば、コード内の
＞If .Value <> "" Then
の行を
＞If .Row Mod 2 = 1 And .Value <> "" Then
に訂正してみてください。
（偶数行の入力は何も変化しません）

今度はどうでしょうか？m(_ _)m

この回答へのお礼

tom04さん、ありがとうございました。感謝致します。

お礼日時：2016/02/19 19:44

No.4 回答者： tom04 回答日時： 2016/02/17 20:50

No.3です。

＞シート「Ｂ」のセルの氏名の位置は決まっていません。（バラバラの位置です）

本当にバラバラ（どこのセルでもよい）のですね？
前回のコードを消去し、↓のコードに変更してみてください。
（シートモジュールです）

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, wS As Worksheet
Set wS = Worksheets("A")
With Target
If .Count = 1 And .Value <> "" Then
Set c = wS.Range("A:A").Find(what:=.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
.Offset(1) = c.Offset(, 1)
End If
End If
End With
End Sub

※　いくらバラバラだといっても
ある程度の範囲があるはずだと思いますが、その辺の説明がないので
全てのセルで反応してしまいます。

※　二度手間になるので、バラバラな範囲を書いてもらえていたら
的確なアドバイスができたと思います。m(_ _)m

No.3 回答者： tom04 回答日時： 2016/02/16 21:09

こんばんは！

わざわざVBAでなくても、関数で対応出来ると思いますが、
仮に「B」SheetのA1セルに名前を入力　→　A2セルに「電話番号」を表示させたい！
という場合は
=IFERROR(VLOOKUP(A1,A!B:C,2,0),"")
だけで大丈夫だと思います。

どうしてもVBAで！というご希望であれば・・・
VBAの場合は具体的なセル配置が判らないと全く意味のないコードになってしまいますが、参考程度で。

「B」SheetのA1セルに名前を入力し、その下のセルに「電話番号」を表示させる場合のコードです。
「B」Sheetのシートモジュールにしてください。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, wS As Worksheet
Set wS = Worksheets("A") '←「A」の部分は実際のSheet名に！
With Target
If .Address = "$A$1" And .Count = 1 Then
Set c = wS.Range("B:B").Find(what:=.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
.Offset(1) = c.Offset(, 1)
Else
MsgBox "該当データなし"
.Select
End If
End If
End With
End Sub

こんな感じでしょうかね。m(_ _)m

No.2 回答者： Hypnomatic 回答日時： 2016/02/16 20:56

指定した名前の人物の電話番号を表示したいのであれば、VBAを利用しないでも、関数で対応可能です。

添付図はシートBであり、B2セルには以下の式が入っています
（シート１のB列には氏名、C列には電話番号）
=VLOOKUP($B$1,A!$B:$C,2,0)


また、シートAのように名前のセルの右隣に電話番号が入っている状態から、名前の下のセルに電話番号を移す方法としては、最初に名前と電話番号が入力してある範囲をコピーし、右クリックのメニューから「形式を選択して貼り付け」を選択肢、貼り付けのメニューから「行と列を入れ替える」を選択することで一括で変換できます

どうしても、VBAでやりたいということであれば、他の回答者様を参考にしてください。

No.1 回答者： nao0620 回答日時： 2016/02/16 20:12

dim i as integer

i=2
do until worksheets("A").cells(2,i).value = ""
worksheets("B").cells(2,i).value = worksheets("A").cells(2,i).value
worksheets("B").cells(3,i).value = worksheets("A").cells(3,i).value
i = i + 1
loop
上記のように、1行1行代入するやり方ではいかがですか。