Option Explicit

    Sub test()

        Dim LastColumn As Long, StartPoint As Long, EndPoint As Long, i As Long, y As Long

        With ThisWorkbook.Worksheets("Sheet1")

            'Find the last column of row 1
             LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column

            'Set StartPoint
            StartPoint = 1

            'Loop row 1
            For i = 1 To LastColumn

                If i = StartPoint Then

                    For y = i + 1 To LastColumn

                        If .Cells(1, i).Value <> .Cells(1, y).Value Then

                            EndPoint = y - 1
                            Exit For

                        End If

                    Next y

                    Application.DisplayAlerts = False

                        With .Range(.Cells(1, StartPoint), Cells(1, EndPoint))
                            .Merge
                            .HorizontalAlignment = xlCenter
                            .VerticalAlignment = xlCenter
                        End With

                    Application.DisplayAlerts = True

                    StartPoint = y
                    EndPoint = 0

                End If

            Next i

        End With

    End Sub