smokebreak
Registered User

you post is closed but this will do the trick


Option Explicit
Sub ptest()
Dim Unqiue As New Collection, cell As Range, pInt, x, y, z, v
For Each cell In Range("D1", Range("D" & Rows.Count).End(xlUp))
Unqiue.Add cell.Offset(0, -3).Value & "," & cell.Offset(0, -2).Value & "," & cell.Offset(0, -1).Value & "," & _
cell.Value & "," & cell.Offset(0, 1).Value, CStr(cell.Value)
On Error Resume Next
Next cell
x = 1
For pInt = 1 To Unqiue.Count
y = 1
For Each z In Split(Unqiue.Item(pInt), ",")
Sheets("Sheet3").Cells(x, y).Value = z
y = y + 1
Next
x = x + 1
Next
End Sub