エクセルVBAで 指定のデーターを指定のシートへ書き込む方法

質問

入力する表が　下記の通りです

日付　　氏名　　　　内容
１　　　Aさん　　　１２３４５
２　　　Bさん　　　２３４５６
３　　　Cさん　　　３４５６７
２　　　Aさん　　　５６７８９
３　　　Bさん　　　９８７６５
５　　　Aさん　　　３４９８６
というような表です

シート名は"Aさん"という名のシートと"Bさん"というシートと"Cさん"という名のシートがあります。

そのAさんという名のシートには

日付　　内容
１　　　
２　　　
３
４
５
６

というような　表があります。これは"Bさん""Cさん"ともいっしょです
この"Aさん""Bさん""Cさん"の名前を判別して、その"内容"をAさんならAさんのシートの同じ日付の"内容"に書き込みたいのです。
結果としては、
Aさんのシート
日付　　内容
１　　　１２３４５
２　　　５６７８９
３
４
５
６　　　３４９８６

としたいのです。　

どなたかよい方法御座いましたら宜しくお願い致します。

回答No.2

hana-hana3 · ベストアンサー

Sub TENKI()

Dim DATA
Dim i As Integer

'データの範囲（範囲は広くても構わない）
'タイトル行も含む
DATA = Range("A1:C6")

'データの転記（タイトル行を避けて読み込む i=2）
For i = 2 To UBound(DATA)

If DATA(i, 1) = "" Then
'日付欄が空白なら、記入を終了します。
Exit For
Else
'Ｂ列のデータをシート名にします。
Sheets(DATA(i, 2)).Select
'日付（半角整数値）を元に、データを記入します。
'DATA(i, 1) + 1 < この数字(1)は記入開始の縦位置を指示
'Cells(, 2)　< この数字(2)は記入開始横位置を指示
Cells(DATA(i, 1) + 1, 2) = DATA(i, 3)
End If
Next

MsgBox "転機終了"

End Sub

ＶＢＡの基本的なプログラムが解れば、理解可能だと思います。

回答No.1

imogasi

（例データ）
Ｓｈｅｅｔ６に
日付 氏名 内容
2004/7/1 Ａさん 12345
2004/7/2 Ｂさん 23456
2004/7/3 Ｃさん 34567
2004/7/2 Ａさん 56789
2004/7/3 Ｂさん 98765
2004/7/5 Ａさん 34986
別にＡさん、Ｂさん、Ｃさんと言う名のシート名に３シートを変えておく。Ａ，Ｂ、Ｃの文字の全角・半角に注意。
本件では全角。
（ＶＢＡコード）
標準モジュールに
Sub test01()
Dim sh1 As Worksheet
Set sh1 = Worksheets("Sheet6")
Dim sname As String
d = sh1.Range("A65356").End(xlUp).Row
' MsgBox d
For i = 2 To d
sname = sh1.Cells(i, "B")
' MsgBox sname
n = Cells(i, "A") - Cells(2, "A") + 1
'MsgBox n
Worksheets(sname).Cells(n, "A") = sh1.Cells(i, "A")
Worksheets(sname).Cells(n, "B") = sh1.Cells(i, "B")
Worksheets(sname).Cells(n, "C") = sh1.Cells(i, "C")
Next i
End Sub
Sheet6のｓの大文字に注意。
（注意）Ａ，Ｂ、Ｃさん各シートのＡ列書式を日付にする
こと。
(結果）
Ａさんシート
2004/7/1 Ａさん 12345
2004/7/2 Ａさん 56789

2004/7/5 Ａさん 34986
Ｂさんシート

38170 Ｂさん 23456
38171 Ｂさん 98765
Ｃさんシート

38171 Ｃさん 34567
私の過去の経験から会得した自家製のコーディング的なところがあります。修正する時は意を汲んでください。