Code:
Public Sub JoinData()
Dim t1 As Worksheet
Dim t2 As Worksheet
Dim matchrow1 As Long
Dim numrows1 As Long
Dim lastrow1 As Long
Dim lastrow2 As Long
Dim lastrow3 As Long
Dim i As Long
Application.ScreenUpdating = False
Set t1 = Worksheets("Sheet1")
With t1
lastrow1 = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Set t2 = Worksheets("Sheet2")
With t2
lastrow2 = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Worksheets.Add after:=Worksheets(Worksheets.Count)
With ActiveSheet
.Range("A1:F1").Value = Array("Order_n", "Product", "Order_Qty", "component", "Quantity", "Total_QTY")
t2.Range("A2").Resize(lastrow2 - 1, 3).Copy .Range("A2")
For i = lastrow2 To 2 Step -1
matchrow1 = 0
On Error Resume Next
matchrow1 = Application.Match(.Cells(i, "B").Value, t1.Columns(1), 0)
On Error GoTo 0
If matchrow1 > 0 Then
numrows1 = Application.CountIf(t1.Columns(1), .Cells(i, "B").Value)
.Rows(i + 1).Resize(numrows1 - 1).Insert
t1.Cells(matchrow1, "B").Resize(numrows1, 2).Copy .Cells(i, "D")
.Cells(i, "A").Resize(, 3).Copy .Cells(i + 1, "A").Resize(numrows1 - 1)
End If
Next i
lastrow3 = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("F2").Resize(lastrow3 - 1).FormulaR1C1 = "=RC[-3]*RC[-1]"
End With
Application.ScreenUpdating = True
End Sub
Bookmarks