here
Sub doCopyData()
Dim lRow As Long
Dim sUnqID As String
Dim Cell As Range
Dim lTgtRow As Long
lRow = 1
Do While (Sheets("Sheet1").Cells(lRow, "A") <> vbNullString)
sUnqID = Sheets("Sheet1").Cells(lRow, "A")
Debug.Print sUnqID
Set Cell = Sheets("Sheet2").Range("Q:Q").Find(sUnqID, Sheets("Sheet2").Cells(Rows.Count, "Q"), , xlWhole, xlByRows, xlNext)
If (Cell Is Nothing) _
Then
Set Cell = Sheets("Sheet2").Cells.Find("*", Sheets("Sheet2").Cells(1, 1), , xlWhole, xlByRows, xlPrevious)
If Cell Is Nothing _
Then
lTgtRow = 1
Else
lTgtRow = Cell.Row + 1
End If
Sheets("Sheet2").Cells(lTgtRow, "Q") = sUnqID
Sheets("Sheet2").Cells(lTgtRow, "U") = Sheets("Sheet1").Cells(lRow, "J")
Else
lTgtRow = Cell.Row
If (Sheets("Sheet2").Cells(lTgtRow, "U") = vbNullString) _
Then
Sheets("Sheet2").Cells(lTgtRow, "U") = Sheets("Sheet1").Cells(lRow, "J")
Else
Sheets("Sheet2").Cells(lTgtRow, "U") = Sheets("Sheet2").Cells(lTgtRow, "U") & ", " & Sheets("Sheet1").Cells(lRow, "J")
End If
End If
lRow = lRow + 1
Loop
End Sub