Sub Test()
Dim a, b, v, rng As Range, i As Long, j As Long
a = Range("D1:F" & Cells(Rows.Count, 4).End(xlUp).Row).Value
ReDim b(1 To UBound(a, 1) + 1000, 1 To UBound(a, 2))
For i = LBound(a) To UBound(a)
v = Application.Match(a(i, 1), Columns(1), 0)
If Not IsError(v) Then
For j = LBound(a, 2) To UBound(a, 2)
b(v, j) = a(i, j)
Next j
If rng Is Nothing Then Set rng = Cells(v, 7).Resize(, 3) Else Set rng = Union(rng, Cells(v, 7).Resize(, 3))
End If
Next i
Range("G1").Resize(UBound(b, 1), UBound(b, 2)).Value = b
If Not rng Is Nothing Then rng.Interior.ColorIndex = 27
End Sub