Sub MergeLinkedCells()
	Dim r as Integer
	Dim i as integer
	Application.DisplayAlerts = False
	With Sheet1
		r = .cells(rows.count,1).end(xlup).row
		for i = r to 2 step-1
			if .cells(i,2).value = .cells(i-1,2).value then
				.range(.cells(i-1,2),.cells(i,2)).Merge
			end if
		next
	End With
	application.DisplayAlerts = True
	
End Sub