Sub mergecells()Dim rng As RangeApplication.DisplayAlerts = Falsemergecells: For Each rng In Selection If rng.Value = rng.Offset(1, 0).Value And rng.Value <> "" Then Range(rng, rng.Offset(1, 0)).Merge Range(rng, rng.Offset(1, 0)).HorizontalAlignment = xlCenter Range(rng, rng.Offset(1, 0)).VerticalAlignment = xlCenter GoTo mergecells End If NextEnd Sub

merge cells.rar