Copying and pasting pages with changes

macropod · #1 11-14-2017, 12:41 PM

Try something along the lines of:

Code:

Sub Demo()
Dim DocSrc As Document, DocTgt As Document, i As Long, Rng As Range
Set DocSrc = ActiveDocument: Set DocTgt = Documents.Add
With DocSrc
  For i = 1 To .ComputeStatistics(wdStatisticPages)
    Set Rng = .Range.GoTo(What:=wdGoToPage, Name:=i)
    Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
    If Rng.Revisions.Count > 0 Then
      With DocTgt.Range
        .InsertAfter Chr(12)
        .Characters.Last.FormattedText = Rng.FormattedText
      End With
    End If
  Next
End With
End Sub

As for headers & footers, you won't be able to get those reliably unless you insert Next Page Section breaks in the output document and unlink the new Sections' headers & footers from the previous one, clear their contents then replicate your existing page's header/footer. And, if there are fields in those headers/footers that include page counts, etc., you'll have to either accept them displaying the wrong values or edit them to display the right ones - in which case they're no longer an accurate copy of the original. Either way, replicating header/footer content is a lot more work than just the above code's insertion of page breaks.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Copying, Cutting and pasting	Steve0513	Excel	1	07-13-2017 05:09 PM
copying and pasting text format	paik1002	Excel	2	10-07-2016 02:34 AM
Prevent Copying and Pasting	Jimmy Tsawo	Excel	3	02-20-2014 03:54 AM
Copying and pasting from Excel	Lorna B	Word	1	03-20-2012 11:58 PM
Copying & Pasting to Firefox problems	mso2u	Word	2	04-07-2011 07:26 AM