人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

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

参照データ
sheet1
A列 B列 C列
AAAA 10 3500
BBBB 50 5300
データ行は2行目からです


コピー先
sheet2からsheet8
B列 H列 I列
AAAA 10 3500
BBBB 50 5300
CCCC
データ行は2行目からです。
よろしくお願いします。

●質問者: inosisi
●カテゴリ:コンピュータ インターネット
✍キーワード:エクセル キー コピー データ マクロ
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● SALINGER
●35ポイント
Sub Macro2()
  '開始行
 Const stRow As Integer = 2
 Dim i As Long
 Dim j As Integer
 Dim lastRow As Long
 Dim obj As Object
 Dim ws1 As Worksheet
 Dim ws2 As Worksheet

  'デフォルトではSheet1は大文字で始まりますが、質問分のようにsheet1にしている場合は合わせてください。
 Set ws1 = Worksheets("Sheet1")
 
 lastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
 
 For i = stRow To lastRow
 For j = 2 To 8
 Set ws2 = Worksheets("Sheet" & j)
 Set obj = ws2.Range("B:B").Find(ws1.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
 If Not obj Is Nothing Then
 ws1.Range(ws1.Cells(i, "B"), ws1.Cells(i, "C")).Copy ws2.Cells(obj.Row, "H")
 End If
 Next
 Next i
End Sub
◎質問者からの返答

ありがとうございます。

申し訳ありませんが

コピー元のA列のコードがコピー先のB列のコードと合致したものが

コピー元のB列C列のデータを

コピー先のsheet2からsheet8のH列I列へコピーできるよう変更できまか

またその名前も変更できるようにお願いしたいのですが

もし再質問になるようでしたら再度質問をあげます。


2 ● SALINGER
●35ポイント ベストアンサー

>コピー元のA列のコードがコピー先のB列のコードと合致したものが

>コピー元のB列C列のデータを

>コピー先のsheet2からsheet8のH列I列へコピーできるよう変更できまか

この部分はそのままだと思います。


名前を変更できるようした変更は

Sub Macro2()
  '開始行
 Const stRow As Integer = 2
 Dim i As Long
 Dim j As Integer
 Dim lastRow As Long
 Dim obj As Object
 Dim ws1 As Worksheet
 Dim ws2 As Worksheet
 Dim h As Variant

  'デフォルトではSheet1は大文字で始まりますが、質問分のようにsheet1にしている場合は合わせてください。
 Set ws1 = Worksheets("Sheet1")
 
  'シート名は任意ということで以下を変更してください
 h = Array("Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8")
 
 lastRow = ws1.Cells(Rows.Count, "A").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, "A"), LookIn:=xlValues, lookat:=xlWhole)
 If Not obj Is Nothing Then
 ws1.Range(ws1.Cells(i, "B"), ws1.Cells(i, "C")).Copy ws2.Cells(obj.Row, "H")
 End If
 Next
 Next i
End Sub
◎質問者からの返答

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

なかなかマクロがきかなかったのですが

何回かやっているうち最後にうまくゆきました。

ありがとうございまし。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ