Getting rid of Merged cells Merged cells are a PITA in Excel. They prevent doing a lot of actions and make copying columns impossible. So I wrote this little code to change all the merged cells in a given sheet into 'Center across selection'.
I did NOT test against vertically merged cells, but it should not trigger an error (just unmerge them).

Sub fixMergedCells(sh As Worksheet)
'replace merged cells by Center Acroos Selection
'high perf version using a hack: https://stackoverflow.com/a/9452164/78522
    Dim c As Range, used As Range
    Dim m As Range, i As Long
    Dim constFla: constFla = Array(xlConstants, xlFormulas)

    Set used = sh.UsedRange
    For i = 0 To 1  '1 run for constants, 1 for formulas
        Err.Clear
        On Error Resume Next
        Set m = Intersect(used.Cells.SpecialCells(constFla(i)), used.Cells.SpecialCells(xlBlanks))
        On Error GoTo 0
        If Not m Is Nothing Then
            For Each c In m.Cells
                If c.MergeCells Then
                    With c.MergeArea
                        'Debug.Print .Address
                        .UnMerge
                        .HorizontalAlignment = xlCenterAcrossSelection
                    End With
                End If
            Next c
        End If
    Next i
End Sub

Sub test_fixMergedCells()
    fixMergedCells ActiveSheet
End Sub
Vertically Merged Cells

I did NOT test against vertically merged cells, but it should not trigger an error (just unmerge them).

You code will unmerge the cells and set each cells .HorizontalAlignment = xlCenterAcrossSelection.
Target Area
Changing the target area from a Worksheet to a Range would make your code more versatile.

Sub fixMergedCells(sh As Worksheet)

Sub fixMergedCells(Target As Range)
    Set Target = Intersect(Target, Target.parent.UsedRange)


SpecialCells
SpecialCells are a PITA.  I would use Range.Find(&quot;*&quot;, SearchFormat:=True).

   Application.FindFormat.MergeCells = True
   Set c = Target.Find(&quot;*&quot;, SearchFormat:=True)
   Do Until c is Nothing 


Unfortunately neither SpecialCells or Range.Find are going to find Merged cells if they are blank.  It might be better to search each cell in the range.
Center Across Selection
Merged cells are not always centered.  You might want to add a condition that if centered then Center Across Selection.

 If .HorizontalAlignment = xlCenter Then .HorizontalAlignment = xlCenterAcrossSelection