Rui Mariano was telling us:
Rui Mariano nous racontait que :

Try this: (Note that this will work only with Word 2003 and that it does
not have any code for error handling...)

'_______________________________________
Option Explicit
'_______________________________________
Sub SplitBy10()

Dim UserRge As Range
Dim BlockRge As Range
Dim StartRge As Long
Dim EndRge As Long
Dim i As Long
Dim NewDoc As Document
Dim CurDocName As String
Dim CurDocPath As String
Dim NewDocSuffix1 As String
Dim NewDocSuffix2 As String
Dim NewDocName As String

Application.ScreenUpdating = False

Set UserRge = Selection.Range
Selection.HomeKey wdStory

With ActiveDocument
   .Save
   CurDocName = Left(.Name, Len(.Name) - 4)
   CurDocPath = .Path

   For i = 1 To ActiveWindow.ActivePane.Pages.Count / 10
       If i = 1 Then
           StartRge = .Range.Start
           NewDocSuffix1 = "p" & i
       Else
           StartRge = Selection.Start
           NewDocSuffix1 = "p" & ((i * 10) - 9)
       End If
       If i < ActiveWindow.ActivePane.Pages.Count / 10 Then
           Selection.GoTo wdGoToPage, wdGoToAbsolute, (1 * (i * 10)) + 1
           EndRge = Selection.Range.Characters.First.Start
           NewDocSuffix2 = "p" & (i * 10)
       Else
           EndRge = .Range.End
           NewDocSuffix2 = "p" & ActiveWindow.ActivePane.Pages.Count
       End If
       Set BlockRge = .Range(StartRge, EndRge).FormattedText
       Set NewDoc = Documents.Add(Visible:=False)
       NewDocName = CurDocName & "-" & NewDocSuffix1 & "-" & NewDocSuffix2
& ".doc"
       With NewDoc
           .Range.FormattedText = BlockRge
           .SaveAs CurDocPath & Application.PathSeparator & NewDocName
           .Close
       End With
   Next
End With

UserRge.Select

Application.ScreenRefresh
Application.ScreenUpdating = False

End Sub
'_______________________________________