Code:
Sub CreateSet()
Dim target As Worksheet
Dim sh2 As Worksheet
Dim lastrow1 As Long
Dim lastrow2 As Long
Dim nextrow As Long
Dim i As Long, j As Long
Application.ScreenUpdating = False
Set target = Worksheets("result")
target.Range("A1:C1").Value = Array("Supplier", "Product", "Customer")
Set sh2 = Worksheets("Sheet2")
With sh2
lastrow2 = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With Worksheets("Sheet1")
lastrow1 = .Cells(.Rows.Count, "A").End(xlUp).Row
nextrow = 1
For i = 2 To lastrow1
For j = 2 To lastrow2
If sh2.Cells(j, "A").Value = .Cells(i, "A").Value Then
nextrow = nextrow + 1
target.Cells(nextrow, "A").Value = .Cells(i, "A").Value
target.Cells(nextrow, "B").Value = sh2.Cells(j, "B").Value
target.Cells(nextrow, "C").Value = .Cells(i, "B").Value
End If
Next j
Next i
End With
Application.ScreenUpdating = True
End Sub
]
Bookmarks