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

質問

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

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

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

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

回答No.7

pkh4989 · ベストアンサー

失礼しました。間違いがありました。

再度以下のモジュールで試してください。
ちなみに、 入力データがカラム120まであって、これを30カラムずつ分解するとしたら、
wCOLUMN = 30 '1ページのカラム列数
wSHEET = 4 '1ページのカラム分解数
になります。すみません。

Sub PAGE_分割()
Dim sLine As Integer
Dim eLine As Integer
Dim wPAGE As Integer
Dim wLINE As Integer
Dim wCOLUMN As Integer
Dim wSHEET As Integer
Dim sCOL As Integer
Dim eCOL As Integer
Dim DataSht As String
Dim wSHEETCnt As Integer
'
wSHEETCnt = 0
wPAGE = 10 'ページ数
wLINE = 50 '1ページの行数
wCOLUMN = 30 '1ページのカラム列数
wSHEET = 4 '1ページのカラム分解数
DataSht = "DATA" 'データのシート名
'ROW
For wRow = 1 To wPAGE
If wRow = 1 Then
sLine = 1
sCOL = 1
Else
sLine = eLine + 1
sCOL = eCOL + 1
End If
eLine = wRow * wLINE
'COLUMN
For wCOL = 1 To wSHEET
If wCOL = 1 Then
sCOL = 1
Else
sCOL = eCOL + 1
End If
eCOL = wCOL * wCOLUMN

Sheets.Add after:=Sheets(Sheets.Count) 'シートを生成
wSHEETCnt = wSHEETCnt + 1
ActiveSheet.Name = "PAGE" & wSHEETCnt 'シート名を付ける
'ページ単位でデータをコピー
Sheets(DataSht).Range(Sheets(DataSht).Cells(sLine, sCOL), Sheets(DataSht).Cells(eLine, eCOL)).Copy _
Destination:=Sheets("PAGE" & wSHEETCnt).Range("A1")
Next
Next
End Sub

お礼

できました！　きれいに表ごとにシートに分割されました。
ほんと、すごいです～～。これで、仕事が数段はかどります。
ありがとうございました。