Maybe this is better, assuming duplicated values is in column 1 and values to merge is in the column next to column 1.
Sub Macro1()
Dim lc As Integer
Dim x As Integer
Dim d As Range
Application.DisplayAlerts = False
Set d = ThisWorkbook.Sheets(1).UsedRange
lc = d.Columns.Count
For Each cell In d.Columns(1).Cells
If cell.Value = cell.Offset(1, 0).Value And x = 0 Then
x = cell.Row
ElseIf Application.WorksheetFunction.CountIf(d.Columns(1), cell.Value) <> 1 And cell.Value <> cell.Offset(1, 0).Value Then
Range(cell.Offset(-(cell.Row - x), 1), cell.Offset(0, 1)).Select
Selection.Merge
x = 0
End If
Next cell
Application.DisplayAlerts = True
End Sub