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.