Sub DeleteBlankRowSort()
Dim i&
Dim n&
  With ActiveSheet.ListObjects(1)
        'удаляем из таблицы строки где в столбце С пусто
      .Range.AutoFilter
      .Range.AutoFilter Field:=3, Criteria1:=""
      Application.DisplayAlerts = False
      On Error Resume Next
      .DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
      Application.DisplayAlerts = True
      .Range.AutoFilter
         'сортировка по столбцу Е
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Intersect(.DataBodyRange, Columns(5)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
         With .Sort
           .Header = xlYes
           .MatchCase = False
           .Orientation = xlTopToBottom
           .SortMethod = xlPinYin
           .Apply
         End With
          'расстановка разрывов
   For i = .ListRows.Count To .DataBodyRange.Row Step -1
         n = Mid(.DataBodyRange(i, 5), 1, 1)
       If Mid(.DataBodyRange(i, 5), 1, 1) <> Mid(.DataBodyRange(i - 1, 5), 1, 1) Then
         ActiveSheet.HPageBreaks.Add .ListRows(i).Range
       End If
   Next
End With
End Sub