No.7ベストアンサー
- 回答日時:
失礼しました。
間違いがありました。再度以下のモジュールで試してください。
ちなみに、 入力データがカラム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.8
- 回答日時:
Sheetをコピーして、不要な行、列を削除してはどうでしょうか
このとき他のセルで参照している項目を削除すると#REF!とエラーになるのでこの部分の参照項目を新しいSHeetの項目に書き換えます。
最初に作成するSheetを入力項目を主(式も可)にすると変換がスムーズに行くと思います。
No.5
- 回答日時:
すみません。
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
- 回答日時:
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
この回答への補足
回答、ありがとうございます!
でも、今回はうまくいきませんでした~。
「1カラムの列数」というのは、表の列数のことでいいんでしょうか?
そう理解してやってみたら、列方向では分割されず、その数の行で切れた表が別シートに出てきました。
それから、最後のところ、
Sheets(DataSht).Range(Sheets(DataSht).Cells(sCOL, sLine), Sheets(DataSht).Cells(eCOL, eLine)).Copy _
Destination:=Sheets("PAGE" & wSHEETCnt).Range("A1")
で止まってしまいました。
マクロ、まったくの素人なので、何が起こっているのか理解不能です・・・。よろしくお願いします!
No.3
- 回答日時:
マクロでやる方法です。
縦横の改ページの位置から自動的にコピー範囲を取得し、シートを追加してコピーします。したがって、各表の間に改ページがある必要があります。
まず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
- 回答日時:
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を押す)する
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) エクセルで 同じシートにある2ページに、おなじページをつけたい 3 2022/07/11 16:15
- Excel(エクセル) 【Excel】エクセルの1シートが2枚に分割されてしまうので印刷プレビューを押して閉 4 2022/12/13 13:12
- Excel(エクセル) エクセルのフッタやヘッダーについて 3 2023/02/04 09:45
- Visual Basic(VBA) エクセルのマクロについて教えてください。 1 2023/08/03 11:27
- Excel(エクセル) Excel、同じフォルダ内のExcelファイルの特定シートのみを1つのファイルに集約したい 8 2022/09/07 15:12
- Excel(エクセル) 【マクロ】マクロが保存されているエクセルとは、別のエクセルブックの全シートの非表示列を再表示したい 1 2022/12/24 20:48
- Visual Basic(VBA) Excel VBA 最終行を取得しVlookup関数をコピーする方法をコーディングで教えてください。 3 2023/05/11 13:14
- Excel(エクセル) iphonからone driveに保存してあるExcelを閲覧すると表示の仕方がちがうデータ 2 2022/12/21 13:51
- Excel(エクセル) 【マクロ】マクロが保存されているエクセルとは、別のエクセルのオートフィルターのしぼりをクリアーしたい 2 2022/12/24 08:36
- Excel(エクセル) エクセルで割り振りをする方法 7 2022/08/02 14:02
このQ&Aを見た人はこんなQ&Aも見ています
-
性格の違いは生まれた順番で決まる?長男長女・中間子・末っ子・一人っ子の性格の傾向
同じ環境で生まれ育っても、生まれ順で性格は違うものなのだろうか。家庭教育研究家の田宮由美さんに教えてもらった。
-
エクセルの1シートを項目別に別シートへ分ける方法
Excel(エクセル)
-
エクセルのページをシートごとに自動分割するやり方について(列、行ともに同一に)
Excel(エクセル)
-
一つのシートの中に複数のページを作る方法
Excel(エクセル)
-
-
4
エクセルで1つのシートを拠点別に複数のシートに分けたい
Excel(エクセル)
-
5
EXCEL の表を一行ずつシートに分ける方法
Excel(エクセル)
-
6
エクセルである列の項目毎にシートに分ける方法を教えてください。
仕事術・業務効率化
-
7
エクセルで複数のシートを別ファイルに分けたい
Excel(エクセル)
-
8
エクセルで50行ごとに区切ったデータをシートに分割したい
Excel(エクセル)
-
9
1行を1シートずつに書き出すには
Excel(エクセル)
-
10
エクセルで条件に一致したセルの隣のセルを取得したい
その他(Microsoft Office)
-
11
Excelで項目ごとにシートを振り分ける方法
Excel(エクセル)
-
12
エクセルで20万行あるシートから100行ずつ抽出したいのですが
Excel(エクセル)
-
13
IF関数で空欄(")の時、Nullにしたい
その他(Microsoft Office)
-
14
リンク元の日付が空白の時リンク先セルも空白にしたい
Excel(エクセル)
-
15
1年分のデータから特定の月分のデータを抽出→表示
Excel(エクセル)
-
16
数式による空白を無視して最終行を取得するマクロ
Excel(エクセル)
-
17
エクセル 違う表から同じ日付のデータを検索
Excel(エクセル)
-
18
エクセルの担当者別にシートを分けて表示するマクロ
Excel(エクセル)
関連するカテゴリからQ&Aを探す
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excel 関数を使ってデータと一...
-
エクセルの選択範囲以外を削除...
-
EXCELのVBAでシートコピーをし...
-
Excelの行をコピーして貼り付け...
-
【VBA】コピー&複数個所のペー...
-
EXCELで別のブックから式をコピ...
-
【Excel】数式をそのまま他のシ...
-
PDFファイルをコピーしてエクセ...
-
アクセスの画面をプリントスク...
-
Excel 数式の保護をしたセルを...
-
エクセルシートを別のエクセル...
-
エクセルVBA 1行飛ばしで転記す...
-
エクセルの1シートの内容を複...
-
エクセルでシートを「移動また...
-
エクセルのシートコピーした際...
-
【Excel】シート全体から一部を...
-
VBA 先頭文字の0(ゼロ)...
-
エクセル 別ファイルから シー...
-
Excel シートに別のExcelシート...
-
【Excel VBA】シートコピー時、...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excel 関数を使ってデータと一...
-
エクセルの選択範囲以外を削除...
-
EXCELのVBAでシートコピーをし...
-
EXCELで別のブックから式をコピ...
-
【Excel】数式をそのまま他のシ...
-
【VBA】コピー&複数個所のペー...
-
Excelの行をコピーして貼り付け...
-
CSVファイルについて質問です。
-
【エクセル】プルダウン設定の...
-
Excel シートのコピーの際、ペ...
-
Excel 数式の保護をしたセルを...
-
【Excel VBA】シートコピー時、...
-
エクセルの1シートの内容を複...
-
ExcelVBAで、ユーザーフォーム...
-
Excel シートに別のExcelシート...
-
シートが保護されていないのに...
-
PDFファイルをコピーしてエクセ...
-
エクセルシートを別のエクセル...
-
エクセルVBA 1行飛ばしで転記す...
-
エクセルでシートを「移動また...
おすすめ情報