質問です。

エクセルのsheet1にあるデータを参照してsheet2からsheet8のB列のキーに合致する行にE列F列G列のデータをコピーするマクロをお願いします。

参照データ
sheet1
B列    E列   F列   G列
AAAA   1000  500   20  
BBBB   2000  300   50   
データ行は2行目からです


コピー先
sheet2からsheet8
B列    E列   F列   G列
AAAA   1000  500   20  
BBBB   2000  300   50 
CCCC
データ行は2行目からです。

sheet2からsheet8までの名前は任意に変更できるように
マクロの作成お願いします。

よろしくお願いします。

回答の条件
  • 1人3回まで
  • 13歳以上
  • 登録:2011/05/14 10:33:09
  • 終了:2011/05/14 12:56:07

ベストアンサー

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692011/05/14 11:08:26

ポイント60pt
Sub Macro3()
    '開始行
    Const stRow As Integer = 2
    Dim i As Long
    Dim lastRow As Long
    Dim obj As Object
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim h As Variant
    Dim j As Integer

    'デフォルトではSheet1は大文字で始まりますが、質問分のようにsheet1にしている場合は合わせてください。
    Set ws1 = Worksheets("Sheet1")
    
    'シート名は任意ということで以下を変更してください
    h = Array("Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8")
    
    lastRow = ws1.Cells(Rows.Count, "B").End(xlUp).Row
    
    For i = stRow To lastRow
        For j = 0 To UBound(h)
            Set ws2 = Worksheets(h(j))
            Set obj = ws2.Range("B:B").Find(ws1.Cells(i, "B"), LookIn:=xlValues, lookat:=xlWhole)
            If Not obj Is Nothing Then
                ws1.Range(ws1.Cells(i, "E"), ws1.Cells(i, "G")).Copy ws2.Cells(obj.Row, "E")
            End If
        Next
    Next i
End Sub
id:inosisi4141

ありがとうございました。

うまく行きました。バッチリです。

また使って何か追加変更等がありましたら

再質問しますのでよろしくお願いします。

2011/05/14 11:52:27

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません