Sub PageBreak()
      Application.ScreenUpdating = 0: Application.EnableEvents = 0
      Dim F&, L&, I&, J&, K&, S$
        
      With ActiveSheet.UsedRange
          F = .Column
          L = .Column + .Columns.Count - 1
      End With
        
      Do While I < ActiveSheet.HPageBreaks.Count
          I = I + 1
          J = ActiveSheet.HPageBreaks(I).Location.Row
          For K = F To L
              If Cells(J, K).MergeCells And Cells(J - 1, K).MergeCells Then
                  If Cells(J, K).MergeArea.Address = Cells(J - 1, K).MergeArea.Address _
                  And S <> Cells(J, K).MergeArea.Address Then
                      S = Cells(J, K).MergeArea.Address
                      Set ActiveSheet.HPageBreaks(I).Location = Cells(J, K).MergeArea.Offset(1)
                  End If
              End If
          Next
      Loop
      Application.ScreenUpdating = 1: Application.EnableEvents = 1
End Sub