Sub myTest()
Dim Target As Range, tc As Range, qf As Range, qe As Range
Sheets(2).Cells.Clear
With Sheets(1)
.UsedRange.Columns(1).Copy Sheets(2).Cells(1)
With Sheets(2)
Set Target = .UsedRange
Target.RemoveDuplicates Columns:=1, Header:=xlYes
For Each tc In Target.Cells
With Sheets(1).Columns(1)
Set qf = .Find(tc)
Set qe = .FindPrevious(after:=qf)
qf.Offset(, 1).Resize(, 2).Copy tc.Offset(, 1)
qe.Offset(, 3).Resize(, 2).Copy tc.Offset(, 3)
End With
Next tc
End With
End With
End Sub