Sub Separators_Shift(R As Range)
    '----------------------------------------------------------------------------
    'Макрос переносит разрыв перед последней страницей таким образом, чтобы
    'последняя строка, предществующая блоку подписей, при печати располагалась
    'на одной странице с блоком подписей
    '----------------------------------------------------------------------------
    'Макрос вызывать в конце, т.е. например создать имя диапазона "Я_МАКРОС"
    'В качестве параметра должно передаваться количество строк в блоке подписей
    '----------------------------------------------------------------------------
   
    Dim Сolumn_IDX As Long      'номер колонки, по которой будет определяться последняя заполненная строка
    Dim LastRow As Long         'последняя заполненная строка
    Dim T As Long               'строка над которой находится первый разрыв страницы
    Dim Podpis_Count As Long    'количество строк в блоке подписей
    Dim Shift_Counts As Double  'текущий сдвиг разрыва страницы в сантиметрах
   
    Podpis_Count = R.Value
    R.Value = ""
   
    column_idx = 2  'Определять последнюю заполненную строку будем по 2й колонке
   

    With ThisWorkbook.Sheets(1)
   
        LastRow = .Cells(.Rows.Count, column_idx).End(xlUp).Row  'Последняя заполненная строка
        ActiveWindow.View = xlPageBreakPreview                   'Переход в режим разметки страниц
       
        If .HPageBreaks.Count = 0 Then  'Выходим, если разделителей страниц нет (всего одна страница)
            ActiveWindow.View = xlNormalView  'Переход в обычный режим просмотра документа
            Exit Sub
        End If
       
        T = .HPageBreaks(.HPageBreaks.Count).Location.Row  'Определяем строку, над которой находится первый разрыв страницы

        Do While T + Podpis_Count > LastRow  'Пока последние podpis_count+1 строк не окажутся на одной странице
            Shift_Counts = Shift_Counts + 0.1    'Наращиваем сдвиг разрыва
            .PageSetup.BottomMargin = Application.CentimetersToPoints(Shift_Counts)  'Сдвигаем разрыв
            If .HPageBreaks.Count = 0 Then       'Выходим, если разделителей страниц больше нет
                ActiveWindow.View = xlNormalView  'Переход в обычный режим просмотра документа
                Exit Sub
            End If
            T = .HPageBreaks(.HPageBreaks.Count).Location.Row  'Определяем строку, над которой находится 1й разрыв страницы
        Loop

    End With
    ActiveWindow.View = xlNormalView  'Переход в обычный режим просмотра документа
End Sub

Private Sub Workbook_BeforePrint(Cancel As Boolean) 'Неразрывные подписи
  ActiveSheet.ResetAllPageBreaks
  Dim R As Range
  Set R = Range("ИтогиПодписи")
  Set R = R.Offset(-1, 0).Resize(R.Rows.Count + 1, R.Columns.Count)
  R.Rows.PageBreak = xlPageBreakNone
  For Each Rw In R.Rows
    If Rw.PageBreak = xlPageBreakAutomatic Then
      R.Rows.PageBreak = xlPageBreakManual
    End If
  Next
End Sub