I have no idea what happened to my last post - there was a whole lot more there after I posted it. Trying again.

Replace:
[VBA]'Call ReplicateLayout(wdDoc.Sections(i), ActiveDocument.Sections(i + 1))
For Each HdFt In .Sections(i).Headers
With ActiveDocument.Sections(i + 1)
If .Headers(HdFt.Index).Exists Then
.Headers(HdFt.Index).Range.Copy
HdFt.Range.PasteAndFormat Type:=wdFormatOriginalFormatting
.Headers(HdFt.Index).Range.Characters.Last.Delete
End If
End With
Next
For Each HdFt In .Sections(i).Footers
With ActiveDocument.Sections(i + 1)
If .Footers(HdFt.Index).Exists Then
.Headers(HdFt.Index).Range.Copy
HdFt.Range.PasteAndFormat Type:=wdFormatOriginalFormatting
.Footers(HdFt.Index).Range.Characters.Last.Delete
End If
End With
Next [/VBA]
with:
[VBA]'Call ReplicateLayout(.Sections(i), Rng.Sections(i))
' Replicate the last Section's headers & footers.
For Each HdFt In .Sections(i).Headers
With Rng.Sections(i).Headers(HdFt.Index)
If .Exists Then
HdFt.Range.Copy
.Range.PasteAndFormat Type:=wdFormatOriginalFormatting
.Range.Characters.Last.Delete
End If
End With
Next
For Each HdFt In .Sections(i).Footers
With Rng.Sections(i).Footers(HdFt.Index)
If .Exists Then
HdFt.Range.Copy
.Range.PasteAndFormat Type:=wdFormatOriginalFormatting
.Range.Characters.Last.Delete
End If
End With
Next[/VBA]