エクセルの１シートの内容を複数のシートに分割したい。

質問

前任者から引き継いだエクセルのファイルを見やすくしたいと思っています。

1ページにつき１つの表が作られているのですが、一枚のシートのページ数が膨大で、とても見にくいのです。ページ毎に（一つの表毎に）違うシートにしたいのですが、地道にコピー＆ペーストをしなければならないでしょうか。

一発でバチッとページ毎にシートにできる方法はありますか？

windowsXP, Excel 2002を使用しています。

回答No.3

ham_kamo

マクロでやる方法です。
縦横の改ページの位置から自動的にコピー範囲を取得し、シートを追加してコピーします。したがって、各表の間に改ページがある必要があります。

まずAlt+F11を押すとVBAの画面が開くので、左側のツリーからブック名を選択し、右クリックから「挿入」＞「標準モジュール」を選択して、右の画面に以下のマクロをコピーして貼り付けてください。

Sub 表をシートに分割()
　Dim V_Page As Integer, H_Page As Integer
　Dim V As Integer, H As Integer
　Dim Top As Integer, Left As Integer
　Dim Bottom As Integer, Right As Integer
　Dim NewWS As Worksheet
　Dim P_Area As Range
　With Worksheets("Sheet1") '元の表があるシート名を指定
　　H_Page = .HPageBreaks.Count + 1 '行方向のページ数
　　V_Page = .VPageBreaks.Count + 1 '列方向のページ数
　　Set P_Area = .Range(.PageSetup.PrintArea) '印刷範囲を取得
　　For V = 1 To V_Page '列方向のループ
　　　For H = 1 To H_Page '行方向のループ
　　　　'コピーする表の左上の行番号を取得
　　　　If H = 1 Then
　　　　　Top = P_Area.Cells(1).Row
　　　　Else
　　　　　Top = .HPageBreaks(H - 1).Location.Row
　　　　End If

　　　　'コピーする表の左上の列番号を取得
　　　　If V = 1 Then
　　　　　Left = P_Area.Cells(1).Column
　　　　Else
　　　　　Left = .VPageBreaks(V - 1).Location.Column
　　　　End If

　　　　'コピーする表の右下の行番号を取得
　　　　If H < H_Page Then
　　　　　Bottom = .HPageBreaks(H).Location.Row - 1
　　　　Else
　　　　　Bottom = P_Area.Cells(P_Area.Cells.Count).Row
　　　　End If

　　　　'コピーする表の右下の列番号を取得
　　　　If V < V_Page Then
　　　　　Right = .VPageBreaks(V).Location.Column - 1
　　　　Else
　　　　　Right = P_Area.Cells(P_Area.Cells.Count).Column
　　　　End If

　　　　'シートを一番後ろに追加
　　　　Set NewWS = Worksheets.Add(after:=Worksheets(Worksheets.Count))
　　　　NewWS.Name = "表" & (V - 1) * H_Page + H '表の名前をつける

　　　　'表を追加したシートにコピー
　　　　.Range(.Cells(Top, Left), .Cells(Bottom, Right)).Copy NewWS.Cells(1, 1)
　　　Next
　　Next
　End With
End Sub

その画面でF5キーを押すか、Alt+F11でExcelの画面に戻ってAlt+F8からマクロを実行してみてください。「表1」「表2」というシートに各表が分割されます。

お礼

回答ありがとうございました。

手順がわかりやすくて、大変参考になりました。
F5で実行すると途中で止まってしまうのですが、多分私の入力ミスかと・・・。
いろいろ試してみます。

ありがとうございました。