VBA セルの値と同じ名前のシートにデータを補填するやり方を教えてください エクセルのブックがありま

VBA セルの値と同じ名前のシートにデータを補填するやり方を教えてください


エクセルのブックがあります。シート1の一列目に名前が入っています。二列目以降は一列目に付随したデータが入っています。一列目に入っている名前と同じシートがそれぞれあり、do loopでシート1の名前を順番に見にいき、セルの値とシートの名前が同じだったら、シート1の行をコピーして、貼り付けていくというマクロを組みたいです。どうしたらくめますでしょうか？

イメージとしては
a=2
do until cells(a,1)='' ''
If cells(a,1)=シート名 then
Range(cells(a,1),cells(a,5).copy
同じ名前のシートにはりつけ…なんですが、同じ名前を探しにいくのが、わからず。です。

教えてください。

No.1 回答者： tom04 回答日時： 2017/02/16 22:31

こんばんは！

色々やり方はありますが、一例です。
貼り付け先が判らないので存在するSheetのA2セル以降に貼り付けするとしています。

Sub Samle1()
Dim i As Long, k As Long, myFlg As Boolean
With Worksheets("Sheet1")
For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
For k = 2 To Worksheets.Count
If Worksheets(k).Name = .Cells(i, "A") Then
myFlg = True
Exit For
End If
Next k
If myFlg = True Then
Range(.Cells(i, "A"), .Cells(i, "E")).Copy Worksheets(k).Range("A2") '←貼り付け先はA2
myFlg = False
End If
Next i
End With
End Sub

こんな感じではどうでしょうか？m(_ _)m

この回答へのお礼

本日会社でやってみます。
ありがとうございます。

お礼日時：2017/02/17 05:43

No.2 ベストアンサー 回答者： TH69 回答日時： 2017/02/16 23:17

シート1が一番左にあるとして

ws1=sheet1
a=sheet1の最終入力行番号
b=全シート数
c=名前シートの最終入力行の1行下の行番号
としています。

For i～Next iで一列目に入っている名前をループ
For j～Next jでシート名をループ
もしシート1の一列目に入っている名前がシート名と同じなら
シート1の当該行の1～5列を、名前シートの最終入力行の1行下に代入します。

Sub test()

Dim a, b, c, i As Long, j As Long
Dim ws1 As Worksheet
Set ws1 = Worksheets("sheet1")
a = ws1.Cells(Rows.Count, "A").End(xlUp).Row
b = Worksheets.Count
For i = 2 To a
For j = 2 To b
If ws1.Cells(i, "A").Value = Worksheets(j).Name Then
c = Worksheets(j).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
Worksheets(j).Cells(c, "A").Resize(1, 5).Value = ws1.Cells(i, "A").Resize(1, 5).Value
End If
Next j
Next i

End Sub

この回答へのお礼

ありがとうございます。
本日会社でやってみます！
それからまたご報告します！

お礼日時：2017/02/17 05:43