Microsoft Office Forums - View Single Post - [Solved] Delete a page after Section Break Next Page

macropod · 07-14-2011, 05:43 PM

Hi Aston,

You could use a macro to expedite the process. Here's one to take care of the most common issues.
To use it, simply select a range that spans however many Section breaks need to be deleted for the Sections you want to merge. For example, if you want to merge two consecutive Sections, simply select a range spanning the offending Section break. For three Sections, select a range spanning both offending Section breaks.

Code:

Sub MergeSections()
Application.ScreenUpdating = False
Dim sPageHght As Single, sPageWdth As Single
Dim sHeaderDist As Single, sFooterDist As Single
Dim sTMargin As Single, sBMargin As Single
Dim sLMargin As Single, sRMargin As Single
Dim sGutter As Single, sGutterPos As Single
Dim lPaperSize As Long, lGutterStyle As Long
Dim lMirrorMargins As Long, lVerticalAlignment As Long
Dim lScnStart As Long, lScnDir As Long
Dim lOddEvenHdFt As Long, lDiffFirstHdFt As Long
Dim bTwoPagesOnOne As Boolean, bBkFldPrnt As Boolean
Dim bBkFldPrnShts As Boolean, bBkFldRevPrnt As Boolean
Dim bOrientation As Boolean, oHdFt As HeaderFooter
Dim Sctn1 As Section, Sctn2 As Section
With Selection
  If .Sections.Count = 1 Then
    MsgBox "Selection does not span a Section break", vbExclamation
    Exit Sub
  End If
  Set Sctn1 = .Sections.First: Set Sctn2 = .Sections.Last
  With Sctn1.PageSetup
    lPaperSize = .PaperSize
    lGutterStyle = .GutterStyle
    bOrientation = .Orientation
    lMirrorMargins = .MirrorMargins
    lScnStart = .SectionStart
    lScnDir = .SectionDirection
    lOddEvenHdFt = .OddAndEvenPagesHeaderFooter
    lDiffFirstHdFt = .DifferentFirstPageHeaderFooter
    lVerticalAlignment = .VerticalAlignment
    sPageHght = .PageHeight
    sPageWdth = .PageWidth
    sTMargin = .TopMargin
    sBMargin = .BottomMargin
    sLMargin = .LeftMargin
    sRMargin = .RightMargin
    sGutter = .Gutter
    sGutterPos = .GutterPos
    sHeaderDist = .HeaderDistance
    sFooterDist = .FooterDistance
    bTwoPagesOnOne = .TwoPagesOnOne
    bBkFldPrnt = .BookFoldPrinting
    bBkFldPrnShts = .BookFoldPrintingSheets
    bBkFldRevPrnt = .BookFoldRevPrinting
  End With
  With Sctn2.PageSetup
    .GutterStyle = lGutterStyle
    .MirrorMargins = lMirrorMargins
    .SectionStart = lScnStart
    .SectionDirection = lScnDir
    .OddAndEvenPagesHeaderFooter = lOddEvenHdFt
    .DifferentFirstPageHeaderFooter = lDiffFirstHdFt
    .VerticalAlignment = lVerticalAlignment
    .PageHeight = sPageHght
    .PageWidth = sPageWdth
    .TopMargin = sTMargin
    .BottomMargin = sBMargin
    .LeftMargin = sLMargin
    .RightMargin = sRMargin
    .Gutter = sGutter
    .GutterPos = sGutterPos
    .HeaderDistance = sHeaderDist
    .FooterDistance = sFooterDist
    .TwoPagesOnOne = bTwoPagesOnOne
    .BookFoldPrinting = bBkFldPrnt
    .BookFoldPrintingSheets = bBkFldPrnShts
    .BookFoldRevPrinting = bBkFldRevPrnt
    .PaperSize = lPaperSize
    .Orientation = bOrientation
  End With
  With Sctn2
    For Each oHdFt In .Footers
      oHdFt.LinkToPrevious = Sctn1.Footers(oHdFt.Index).LinkToPrevious
      If oHdFt.LinkToPrevious = False Then
        With oHdFt.Range
          .FormattedText = Sctn1.Footers(oHdFt.Index).Range.FormattedText
          Do While .Characters.Last.Previous = vbCr
            .Characters.Last.Previous.Delete
            If .Characters.Count = 1 Then Exit Do
          Loop
        End With
      End If
    Next
    For Each oHdFt In .Headers
      oHdFt.LinkToPrevious = Sctn1.Headers(oHdFt.Index).LinkToPrevious
      If oHdFt.LinkToPrevious = False Then
        With oHdFt.Range
          .FormattedText = Sctn1.Headers(oHdFt.Index).Range.FormattedText
          Do While .Characters.Last.Previous = vbCr
            .Characters.Last.Previous.Delete
            If .Characters.Count = 1 Then Exit Do
          Loop
        End With
      End If
    Next
  End With
  While .Sections.Count > 1
    .Sections.First.Range.Characters.Last.Delete
  Wend
End With
Set Sctn1 = Nothing: Set Sctn2 = Nothing
Application.ScreenUpdating = True
End Sub

For PC macro installation & usage instructions, see: http://www.gmayor.com/installing_macro.htm
For Mac macro installation & usage instructions, see: http://word.mvps.org/Mac/InstallMacro.html