Что касаемо самой проблемы: не так проста, как кажется. С разгону не подъедешь.
Но вот такой вариант предложить могу:
Sub Make_Pages_Breack()
Dim rUsRng As Range, li As Long, lCnt As Long
Set rUsRng = Range("A1", Cells.SpecialCells(11))
For li = 1 To rUsRng.Rows.Count
If rUsRng.Rows(li).PageBreak <> xlNone Then
If rUsRng.Cells(li, 1).MergeCells Then
lCnt = li - Cells(li, 1).MergeArea.Row
If lCnt > 0 Then Rows(li - lCnt).Resize(lCnt).Insert: lCnt = 0
End If
End If
Next li
End Sub
Подгонит разрывы так, чтобы объединенные ячейки не "разрывались". Сразу оговорюсь - проверяет объединенные ячейки только в первом столбце.
Димитрий,
первым делом, спасибо за код.
А можно его оптимизировать? Отключение и включение нижепреведенных апликаций не сильно ускоряет процесс.
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False