Excelで別のブックから検索してセルのコピペをしたい

製品一覧表というExcelブックがあり、A列に製品コード、B列以降にはその製品名や区分、生産地、生産数等の膨大な情報が載っています。
また区分表というブックもあり、こちらにはA列に製品コード、B列以降には製品名など製品一覧表と一致する情報もあれば、それ以外の情報も載っています。

そこで、区分表の方に、製品コードで検索をして製品一覧表と一致する情報についてコピペしたいと考えております。
値のみであればVLOOKUP関数でよいのですが、製品一覧表にはセルのコメントや色の塗りつぶし等もかなりあり、これらの情報も区分表に載せたいため、何とかVBAで処理したい意向です。

VBAは全くの初心者ということもありいろいろ調べまして、完全に的外れなのかもしれませんが次のコード（製品一覧表B列の製品名とAD列の生産数を、区分表のC列とI列に製品コードで検索して転記）がやりたいことに近かったため、試してみました。
しかしながらやはり値のみが返される状況でしたので、セルのコメントや色も反映させるためにはどのようにすべきかご教示いただけますと幸いです。

おそらくは、copyやpastespecialを使うのだと思うのですが、全くの初心者のため勝手がわからず、大変恐縮です（Excelは、2019を使用しています）。

何卒、よろしくお願いいたします。

--
Option Explicit

Sub テスト()

Dim datasheet As Worksheet
Set datasheet = ThisWorkbook.Worksheets("区分表")

Dim cmax1 As Long
cmax1 = datasheet.Range("A65536").End(xlUp).Row

Dim masterfile As String
masterfile = ThisWorkbook.Path & "\製品一覧表.xlsx"

Dim master As Workbook
Set master = Workbooks.Open(Filename:=masterfile)

Dim mastersheet As Worksheet
Set mastersheet = master.Worksheets("一覧表")

Dim cmax2 As Long
cmax2 = mastersheet.Range("A65536").End(xlUp).Row

Dim product_code As String, master_code As String, product_name As String
Dim i As Long, j As Long, production As Long

For i = 2 To cmax1
product_code = datasheet.Range("A" & i).Value

For j = 2 To cmax2
master_code = mastersheet.Range("A" & j).Value

If product_code = master_code Then
product_name = mastersheet.Range("B" & j).Value
production = mastersheet.Range("AD" & j).Value
Exit For
End If
Next

datasheet.Range("C" & i).Value = product_name
datasheet.Range("I" & i).Value = production
Next

master.Close

End Sub

No.2 ベストアンサー 回答者： Qchan1962 回答日時： 2021/10/21 12:34

こんにちは

該当品番において
一覧表のB列が区分表のC列、一覧表のAD列が区分表のI列に値が代入されるようですが

示されているコードで書式などのコピー以外は正しく出来ていると
解釈してよいのでしょうか？
良いのであれば、変数に値を代入せずにCopyメソッドを使用すれば良いと思います。
該当箇所
If product_code = master_code Then
product_name = mastersheet.Range("B" & j).Value　'変更
production = mastersheet.Range("AD" & j).Value　'変更
Exit For
End If
Next

datasheet.Range("C" & i).Value = product_name　'不要
datasheet.Range("I" & i).Value = production　'不要
Next

変更対象
If product_code = master_code Then
mastersheet.Range("B" & j).copy datasheet.Range("C" & i)
mastersheet.Range("AD" & j).copy datasheet.Range("I" & i)
Exit For
End If
Next

Next


If product_code = master_code Then
Exit For
の為、区分表に同品番がある場合、一覧表の合致する上位行のデータがコピーされます。

一覧表に同品番がある場合、上位行のみがコピーされ下位行にあるデータは
対象になりません。

この回答へのお礼

早速のご回答、ありがとうございます。示させていただいたコードでコピー以外は正しく動作している状況です。
またCopyメソッドについて回答いただき、ありがとうございました。不慣れなため理解に時間がかかってしまいましたが、回答いただいたとおりに修正し、思い通りの結果が得られました。
ここでの質問は初めてですが、質問してよかったと心から思いました。ご親切にありがとうございました。

お礼日時：2021/10/21 16:52

No.3 回答者： mygoonickname 回答日時： 2021/10/21 12:38

おはようございます。

No.1さんの内容をコードにしてみると、下記の様になるかと思います。
＞仮にヒットしなくても、必ず値を代入しようとしているよう　も対応。

If product_code = master_code Then
product_name = mastersheet.Range("B" & j).Value
production = mastersheet.Range("AD" & j).Value
Exit For
End If
Next

datasheet.Range("C" & i).Value = product_name
datasheet.Range("I" & i).Value = production

↓

If product_code = master_code Then
mastersheet.Range("B" & j).copy datasheet.Range("C" & i)
mastersheet.Range("AD" & j).copy datasheet.Range("I" & i)
Exit For
End If
Next

この回答へのお礼

No.1さんの補足をいただき、ありがとうございます。No2さんの内容と総合すると、「ヒットしない場合も必ず代入」は対応し、複数回ヒットは上位行がそれぞれ対象になるということですね。明解に理解することができました。
本当にご親切にありがとうございます。
皆さんをBAにしたいところ、大変恐縮ですが、先に回答いただいたNo2さんをBAにさせていただくこと、お許しください。本当にありがとうございました！

お礼日時：2021/10/21 16:53

No.1 回答者： fujillin 回答日時： 2021/10/21 12:07

こんにちは

＞セルのコメントや色も反映させるためにはどのようにすべきか
＞ご教示いただけますと幸いです。
マクロは基本的に手操作の自動化みたいなものですので、色やコメントをコピーしたければ、（手操作の）コピペと同様のことを行うのが簡単です。
（文字色、背景色、罫線・・などをひとつひとつ設定もできますが、数が多いので面倒ですよね）

ご提示のコードでは、セルの .Value を代入する形式になっていますので、「値のみのコピー」と同様の処理になっています。
セルのコピペを行いたいのであれば、
　(コピー元のRange).Copy Destination:=(ペースト先のRange)
のようになされば宜しいでしょう。
https://docs.microsoft.com/ja-jp/office/vba/api/ …


※ なお、以下はご質問に直接関係ありませんが・・・
検索したときに、必ずヒットするという保証があるのでしょうか？
ご提示のコードだと、仮にヒットしなくても、必ず値を代入しようとしているように思われます。
また、複数回ヒットした場合（←あり得ないのかもしれませんが）には、後のもので上書きされるようになっています。

この回答へのお礼

早速、回答いただきありがとうございます。Valueが値に相当するとのこと、本当に初歩的なことで大変恐縮です。
また、いただいた回答からコピーメソッドについて、少しづつではありますが理解できてきました。
検索では必ずヒットし、複数回ヒットしないようなつくりになっておりますが製品コードの入力ミス等はあるかもしれません。この点についても、お気づきいただきありがとうございました。

お礼日時：2021/10/21 16:35