Excel Forum

Code: Select all

Sub splitter()

Dim Counter As Long, Source As Document, Target As Document
Set Source = ActiveDocument
Selection.HomeKey Unit:=wdStory
Pages = Source.BuiltInDocumentProperties(wdPropertyPages)
Counter = 0
While Counter < Pages
    Counter = Counter + 1
    DocName = "Page" & Format(Counter)
    Source.Bookmarks("\Page").Range.Cut
    Set Target = Documents.Add
    Target.Range.Paste
    Target.SaveAs FileName:=DocName
    Target.Close
Wend
End Sub