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

質問

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

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

お礼

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

回答No.9

shinkami

［コピー＆ペースト］ではなく[カット＆ペースト]…列単位が可能なら［切り取ったセル挿入］
得意先、氏名等 複数sheetに必要な項目は、
入力場所は一つにして、他のsheetは式で参照するようにします。

お礼

回答、ありがとうございました。
地道にコピペをやっていたんですが、参照箇所も多く、また、データも大量なものですから、簡単にできる方法を探していました。
ご意見、ありがとうございました。

回答No.8

shinkami

Sheetをコピーして、不要な行、列を削除してはどうでしょうか

このとき他のセルで参照している項目を削除すると#REF!とエラーになるのでこの部分の参照項目を新しいSHeetの項目に書き換えます。

最初に作成するSheetを入力項目を主（式も可）にすると変換がスムーズに行くと思います。

回答No.6

pkh4989

>「１カラムの列数」というのは、表の列数のことでいいんでしょうか？
すみません。
1カラムの列数というのは、列の分解数です。
例えば、入力データがカラム120まであって、これを30カラムずつ分解するとしたら、4にすればいいです。

お礼

なるほど～。そういうことなんですねー。
勉強になりました。ありがとうございました。

回答No.5

pkh4989

すみません。
ROWとCOLUMNの指定が間違いました。以下のように修正してください。

'ページ単位でデータをコピー
Sheets(DataSht).Range(Sheets(DataSht).Cells(sCOL, sLine), Sheets(DataSht).Cells(eCOL, eLine)).Copy _
Destination:=Sheets("PAGE" & wSHEETCnt).Range("A1")
｜
V
Sheets(DataSht).Range(Sheets(DataSht).Cells(sLine, sCOL), Sheets(DataSht).Cells(eLine, eCOL)).Copy _
Destination:=Sheets("PAGE" & wSHEETCnt).Range("A1")

補足

早速のお返事、ありがとうございます。

でも、今回も同じところで止まってしまいました。
また、今回はシートは増えましたが何も載っていないシートで、
表は分割されていない状態でした。

お手数おかけして恐れ入りますが、よろしくお願いします。
<(_ _)>

回答No.4

pkh4989

No.2 です。
1カラムの列数を入れてください。

Sub PAGE_分割()
Dim sLine As Integer
Dim eLine As Integer
Dim wPAGE As Integer
Dim wLINE As Integer
Dim wCOLUMN As Integer
Dim sCOL As Integer
Dim eCOL As Integer
Dim DataSht As String
Dim wSHEETCnt As Integer
'
wSHEETCnt = 0
wPAGE = 20 'ページ数
wLINE = 50 '1ページの行数
wCOLUMN = 10 '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 wCOLUMN
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(sCOL, sLine), Sheets(DataSht).Cells(eCOL, eLine)).Copy _
Destination:=Sheets("PAGE" & wSHEETCnt).Range("A1")
Next
Next
End Sub

補足

回答、ありがとうございます！
でも、今回はうまくいきませんでした～。

「１カラムの列数」というのは、表の列数のことでいいんでしょうか？
そう理解してやってみたら、列方向では分割されず、その数の行で切れた表が別シートに出てきました。

それから、最後のところ、

Sheets(DataSht).Range(Sheets(DataSht).Cells(sCOL, sLine), Sheets(DataSht).Cells(eCOL, eLine)).Copy _
Destination:=Sheets("PAGE" & wSHEETCnt).Range("A1")

で止まってしまいました。

マクロ、まったくの素人なので、何が起こっているのか理解不能です・・・。よろしくお願いします！

回答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で実行すると途中で止まってしまうのですが、多分私の入力ミスかと・・・。
いろいろ試してみます。

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

回答No.2

pkh4989

VBAを利用すれば出来ると思いますが、但し頁の行数が一定の場合のみです。如何でしょうか。

ページ数、1ページの行数、データのシート名は変えてください。
シートを生成しながら「PAGE1～」コピーします。

Sub PAGE_分割()
Dim sLine As Integer
Dim eLine As Integer
Dim wPAGE As Integer
Dim wLINE As Integer
Dim DataSht As String
'
wPAGE = 20 'ページ数
wLINE = 50 '1ページの行数
DataSht = "DATA" 'データのシート名
For wRow = 1 To wPAGE
If wRow = 1 Then
sLine = 1
Else
sLine = eLine + 1
End If
eLine = wRow * wLINE
Sheets.Add 'シートを生成
ActiveSheet.Name = "PAGE" & wRow 'シート名を付ける
'ページ単位でデータをコピー
Sheets(DataSht).Rows(sLine & ":" & eLine).Copy _
Destination:=Sheets("PAGE" & wRow).Range("A1")
Next

End Sub

'(1) Alt+F11 (ツール -> マクロ -> Visual Basic Editor)
'(2) 挿入 -> 標準モジュール -> 上記のモジュールを貼り付けて実行(F5を押す)する

お礼

できました！！　すごいです！
ありがとうございました。

列方向でも分割したいのですが、それもできるでしょうか？

回答No.1

noname#204879

「一発でバチッとページ毎にシートにできる方」はありません！

お礼

回答ありがとうございました。
地道にコピペするしかないんですかねえ・・・。がんばります。