This code will work, guarentee

Sub mergelist()

Const NewCol = "D"
Const NewColRange = "$" & NewCol & ":$" & NewCol
LastRowColA = Cells(Rows.Count, "A").End(xlUp).Row
Set ColARange = Range(Cells(1, "A"), Cells(LastRowColA, "A"))


For Each Cell In ColARange

Set c = Columns(NewColRange).Find(Cell, LookIn:=xlValues)
If c Is Nothing Then
LastRowColD = Cells(Rows.Count, NewCol).End(xlUp).Row
If (LastRowColD < 1) Or _
Not IsEmpty(Cells(1, NewCol)) Then _
LastRowColD = LastRowColD + 1

Cells(LastRowColD, NewCol) = Cell
Cells(LastRowColD, NewCol).Offset(0, 1) = _
Cell.Offset(0, 1)

Else
LastCol = Cells(c.Row, Columns.Count).End(xlToLeft).Column
Cells(c.Row, LastCol + 1) = Cell.Offset(0, 1)

End If

Next Cell

End Sub


" wrote:

Hello, i have a question:


Column A: Column B:
name1 text
name1 text
name2 text
name3 text
name2 text
name2 text
name2 text
name1 text
name2 text
name2 text
name4 text
name4 text
name4 text
name5 text
name5 text
etc

I want to find all duplicate values in column A and if found copy the
values in B to different columns

Result:
A B C D E F
Name1 text text text
Name2 text text text text text
etc


Hopefully someone can help me because i have a long list and doing by
hand would take forever!

Thanks in advance!!