これは翻訳ならではのニーズかもしれません。
Wordには、複数のファイルを１つのファイルにまとめる機能（[ファイルの挿入]、または、[ファイルからテキスト]）はあるのですが、１つのファイルを複数に分割する機能はないようです。
先日のMicrosoft MVP for Excel の伊藤潔人さんのセミナー で話題になりました。
たしかに、大きなWordのファイルで作業するのは苦痛ですね。これが、Wordが重いといわれるゆえんだと思います。
そこでマクロにしてみました。
設定することがいろいろあって長くなってしまいました。
もっと簡単にできるかもしれませんが、サンプルとして掲載しておきます。
▼このマクロでできること
現在開かれている文書の内容を複数の文書に分割します。
１つの文書のサイズが大きすぎて作業をしにくい場合に便利です。
マクロを実行すると、分割するページ数を入力するインプットボックスが表示されます。
現在開かれている文書が、ここで入力したページ数毎にコピーされ、新しく作成される文書に貼り付けられます。
複数の文書が作成されます。
応用すれば、ファイルの保存先を指定して、ファイル名に番号を付けたりできそうですね。
原稿に対しては、書き込んだり分割したり処理をしませんのでご安心を。
▼マクロの解説
分割するページ数は、デフォルトで20ページとしています。
ここは、お使いのパソコンの性能にあわせて自由に数字を変更してみてください。
ページ最後の文字番号を取得するために、まず最初にカーソルをページ先頭に移動させます。
そして、このカーソル位置のページを示す Bookmarks("\page")オブジェクトから、このページの最後の文字位置（先頭から数えて何文字めか？）を取得しています。
▼マクロ
Sub 文書の分割()
Dim mySplit As Variant '分割後の文書あたりのページ数
Dim myTotalPage As Integer '分割対象の文書の総ページ数
Dim i As Integer
Dim iMax As Integer
Dim actDoc As Document '分割対象の文書
Dim newDoc As Document '分割後の文書
Dim myPage As Integer
Dim myPageStart As Long
Dim myPageEnd As Long
'デフォルトの分割用のページ数
Const myDefault As Integer = 20
'印刷レイアウトに変更
ActiveWindow.View.Type = wdPrintView
Set actDoc = ActiveDocument
'総ページ数
myTotalPage = actDoc.Range.Information(wdNumberOfPagesInDocument)
'何ページごとに分割するのか、ページ数を入力
Do
mySplit = InputBox("分割するページ数を入力してください。" & vbCr & _
"総ページ数：" & myTotalPage, "文書の分割", myDefault)
'キャンセルの場合終了
If mySplit = vbNullString Then Exit Sub
'総ページ数以上の場合に終了
If mySplit >= myTotalPage Then Exit Sub
Loop While IsNumeric(mySplit) = False
'分割数を算出
If myTotalPage Mod mySplit > 0 Then
iMax = (myTotalPage \ mySplit) + 1
Else
iMax = (myTotalPage \ mySplit)
End If
'分割する開始位置を代入（初期値）
myPageStart = 0
For i = 1 To iMax
'分割対象の文書を選択
actDoc.Activate
'分割を開始するページ番号
myPage = i * mySplit
'カーソル位置を移動
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=myPage
'分割する範囲をコピー
With ActiveDocument
If i <> iMax Then
'分割する最終位置を代入（最後の分割ではない場合）
myPageEnd = .Bookmarks("\page").Range.End
Else
'分割する最終位置を代入（最後の分割の場合）
myPageEnd = .Range.End
End If
'範囲を指定してコピー
.Range(myPageStart, myPageEnd).Copy
End With
'新規文書の追加
Set newDoc = Documents.Add
'貼り付け
newDoc.Range.Paste
'次の分割の開始位置を代入
myPageStart = myPageEnd
DoEvents
Next i
'分割対象の文書の先頭にカーソルを移動
With actDoc
.Activate
.Range(0, 0).Select
End With
Set actDoc = Nothing
Set newDoc = Nothing
End Sub
▼関連記事
文の間のシングルスペースをダブルスペースにする