こんなことでしょうか。
Sub test()
Dim wsM As Worksheet
Dim wsD As Worksheet
Dim dic As Object
Dim s As String
Dim t As String
Dim ary As Variant
Dim i As Long, j As Long, r As Long, k As Long
Set wsM = ThisWorkbook.Sheets(1) 'マスタシート
Set wsD = ThisWorkbook.Sheets(2) '入力シート
Set dic = CreateObject("Scripting.Dictionary")
With wsM
For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
s = .Cells(i, 1).Value
If Not dic.Exists(s) Then
dic(s) = CStr(i)
Else
dic(s) = dic(s) & "," & CStr(i)
End If
Next
End With
With wsD
For j = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
s = .Cells(j, 1).Value
If dic.Exists(s) Then
t = dic(s)
If InStr(t, ",") = 0 Then
i = CLng(t)
.Cells(j, 1) = wsM.Cells(i, 2) '図番
.Cells(j, 2) = wsM.Cells(i, 3) '数量
Else '対応するデータがマスターにある場合
ary = Split(t, ",")
i = CLng(ary(0))
.Cells(j, 1) = wsM.Cells(i, 2) '図番
.Cells(j, 2) = wsM.Cells(i, 3) '数量
For k = 1 To UBound(ary)
i = CLng(ary(k))
r = wsD.Cells(Rows.Count, "A").End(xlUp).Row + 1
.Cells(r, 1) = wsM.Cells(i, 2) '図番
.Cells(r, 2) = wsM.Cells(i, 3) '数量
.Cells(r, 3) = .Cells(j, 3) '重量
Next
End If
End If
Next
End With
End Sub
# 余り念入りな検証はしていませんので、そちらでよく確認してください。