Hi Cool As Blu,
Sorry, I misread the question. The following might do it, but it may screw
up the pagelayout, particularly if you have headers/footers and particularly
firstpage headers/footer in the document. Make sure the original document
is saved before running the macro.
Dim Source As Document, Target As Document, Pages As Integer, tarange As
Range
Set Source = ActiveDocument
Set Target = Documents.Add
Source.Activate
Selection.HomeKey Unit:=wdStory
Pages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
counter = 0
While counter < Pages
counter = counter + 1
Source.Bookmarks("\Page").Range.Cut
Set tarange = Target.Range
tarange.Start = tarange.End
tarange.Paste
Set tarange = Target.Range
tarange.Start = tarange.End
tarange.InsertAfter vbCr
tarange.Paste
Wend
Target.PrintOut PrintZoomColumn:=2, PrintZoomRow:=1
Source.Close wdDoNotSaveChanges
See the article “What do I do with macros sent to me by other newsgroup
readers to help me out?
I don't know how to install them and put them to use” at:
http://www.mvps.org/word/FAQs/MacrosVBA/CreateAMacro.htm
Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested. Unsolicited questions forwarded
directly to me will only be answered on a paid consulting basis.
Hope this helps
Doug Robbins - Word MVP