UNMERGE CODE ADJUSTMENT

[stevembe]

I now have loads of single page letters in a merged file that again I want to unmerge. The problem is the single page letter has a Section Break (Continuous) after the address block and a Section Break (Next Page) at the bottom of each page which is where I want it to cut off. The following code is falling down, can anybody please suggest how it can be changed (I did post this earlier but the thread shows as solved):



Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, StrTxt As String, Rng As Range, Doc As Document, HdFt As HeaderFooter
With ActiveDocument
'Process each Section
For i = 1 To .Sections.Count - 1
With .Sections(i)
'Get the 9th paragraph
Set Rng = .Range.Paragraphs(9).Range
With Rng
.MoveEnd wdCharacter, -1
'Construct the destination file path & first part of name
StrTxt = "H:\Terms & Conditions\Final\" & .Text & "_"
End With
'Get the 8th paragraph
Set Rng = .Range.Paragraphs(8).Range
With Rng
.MoveEnd wdCharacter, -1
'Construct balance of file name
StrTxt = StrTxt & .Text & ".docx"
End With
'Get the whole Section
Set Rng = .Range
With Rng
'Contract the range to exclude the Section break
.MoveEnd wdCharacter, -1
'Copy the range
.Copy
End With
End With
'Create the output document
Set Doc = Documents.Add(Template:=ActiveDocument.AttachedTemplate.FullName, Visible:=False)
With Doc
'Paste contents into the output document, preserving the formatting
.Range.PasteAndFormat (wdFormatOriginalFormatting)
'Delete trailing paragraph breaks & page breaks at the end
While .Characters.Last.Previous = vbCr Or .Characters.Last.Previous = Chr(12)
.Characters.Last.Previous = vbNullString
Wend
'Replicate the headers & footers
For Each HdFt In Rng.Sections(1).Headers
HdFt.Range.Copy
.Sections(1).Headers(HdFt.Index).Range.PasteAndFormat (wdFormatOriginalFormatting)
Next
For Each HdFt In Rng.Sections(1).Footers
HdFt.Range.Copy
.Sections(1).Footers(HdFt.Index).Range.PasteAndFormat (wdFormatOriginalFormatting)
Next
'Save & close the output document
.SaveAs FileName:=StrTxt, AddToRecentFiles:=False
.Close SaveChanges:=True
End With
Next
End With
Set Rng = Nothing: Set Doc = Nothing
Application.ScreenUpdating = True
End Sub

[macropod]

You'd have far fewer problems if you were to use a macro to drive the merge process, rather than trying to re-process the output afterwards. See: http://www.gmayor.com/individual_merge_letters.htm (http://www.gmayor.com/individual_merge_letters.htm).

PS: Why do you have a continuous Section Break anyway?

[snb]

If you want separate documents for each record you can use quite another method than mailmerge:

See the attachment.