Sub Вставить_разрывы()
Dim sht As Worksheet
Dim i As Long
Dim iLastRow As Long
  Set sht = ActiveSheet
 With sht
    .ResetAllPageBreaks
    iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
   For i = 10 To iLastRow
    If .Cells(i, "A").MergeArea.Count = 10 Then
      .HPageBreaks.Add Before:=.Rows(i)
    End If
   Next
 End With
End Sub

    For i = iLastRow To 10 Step -1
     If .Cells(i, "A").MergeArea.Count = 10 Then
       .Rows(i).Insert
       Range("A2").Copy Cells(i, "A")
       Cells(i, "A").RowHeight = Range("A2").RowHeight
      .HPageBreaks.Add Before:=.Rows(i)
     End If
   Next