エクセルのマクロについての質問です。
ページ数が100ページ以上あるデータを改ページごとシートに分けたいです。
一つ一つのページの行数は違います。
色々と検索していたら
↓↓↓↓↓↓↓↓↓↓
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
このコードがやりたいことに最も近かったのですが、
列の幅がコピー元と同じにならず、テキストボックスが変に伸びてしまったり、ページ自体の横幅が変わってしまいました。
このコードのどこをどのように変更すれば上記のようにページを分割することができるでしょうか?
ご教授お願いいたします。
No.1ベストアンサー
- 回答日時:
>列の幅がコピー元と同じにならず、テキストボックスが変に伸びてしまったり、ページ自体の横幅が変わってしまいました。
お好みに合うか分かりませんが、個別で設定する方法です。一度にコピペも出来るかもしれませんが、取敢えず、、
列幅です。。
該当箇所
'表を追加したシートにコピー
.Range(.Cells(Top, Left), .Cells(Bottom, Right)).Copy NewWS.Cells(1, 1)
For i = 1 To Right
NewWS.Columns(i).ColumnWidth = .Columns(i).ColumnWidth
Next
Dim i As Long などで i を変数宣言してください。
ありがとうございます!
列幅共にうまくいきました!
しかし、画像の大きさや位置が微妙に元データとずれてしまっていました。
これはセルにコピーをしているからでしょうか?
例えば、列幅が元シートと全く同じシートをページ分用意して、そのシートのA1にセルを挿入するというような動作はできますでしょうか?
No.4
- 回答日時:
補足を読みました。
方法は、大きくプロセスを変えない場合、2つ考えられます。
1つは#2の方法(#3で修正)を試してみる
2つ目は、#1の方法で、行単位のコピペをする。
.Rows(Top & ":" & Bottom).Copy NewWS.Rows(1)
参考まで
No.3
- 回答日時:
#1
>しかし、画像の大きさや位置が微妙に元データとずれてしまっていました。
先にコピーしてから列幅設定しているせいかもしれません。
検証していませんので、、見落としですね。すみません。
新しいシートを作る
Set NewWS = Worksheets.Add(after:=Worksheets(Worksheets.Count))
NewWS.Name = "表" & (V - 1) * H_Page + H '表の名前をつける
先に
For i = 1 To Right
NewWS.Columns(i).ColumnWidth = .Columns(i).ColumnWidth
Next
を実行して
.Range(.Cells(Top, Left), .Cells(Bottom, Right)).Copy NewWS.Cells(1, 1)
上手く行きますでしょうか。
#2
shapeを見落としていました。
コピー先のShapeを削除する必要がありますね。
Dim shp As Shape
Set NewWS = Worksheets.Add(after:=Worksheets(Worksheets.Count))
NewWS.Name = "表" & (V - 1) * H_Page + H '表の名前をつける
.Cells.Copy NewWS.Cells(1,1)
NewWS.Cells.ClearContents
For Each shp In NewWS.Shapes
shp.Delete
Next shp
'表を追加したシートにコピー
.Range(.Cells(Top, Left), .Cells(Bottom, Right)).Copy NewWS.Cells(1, 1)
>例えば、列幅が元シートと全く同じシートをページ分用意して、そのシートのA1にセルを挿入するというような動作はできますでしょうか?
可能ですが、全体のプロセスを見直す必要がありますね。
今回の回答は、ご掲示のプロセスがありましたので、それに基ずくアドバイスになります。
参考まで
お早いご返信ありがとうございます!
書き直してみました。
これで大丈夫でしょうか?
実行したところ「実行時エラー'1004' この操作は結合したセルには行えません」とメッセージが出てしまいました。7/60シートほどはうまくいっていました!!
デバックの結果「.Range(.Cells(Top, Left), .Cells(Bottom, Right)).Copy NewWS.Cells(1, 1)」この行が黄色く表示されました。
ご回答よろしくお願いします。
Dim i As Long
Dim shp As Shape
'シートを一番後ろに追加
Set NewWS = Worksheets.Add(after:=Worksheets(Worksheets.Count))
NewWS.Name = "表" & (V - 1) * H_Page + H '表の名前をつける
For i = 1 To Right
NewWS.Columns(i).ColumnWidth = .Columns(i).ColumnWidth
Next
.Cells.Copy NewWS.Cells(1,1)
NewWS.Cells.ClearContents
For Each shp In NewWS.Shapes
shp.Delete
Next shp
'表を追加したシートにコピー
.Range(.Cells(Top, Left), .Cells(Bottom, Right)).Copy NewWS.Cells(1, 1)
Next
Next
End With
End Sub
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
-
フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
あなたが普段思っている「これまだ誰も言ってなかったけど共感されるだろうな」というあるあるを教えてください
-
フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
あなたが普段思っている「これまだ誰も言ってなかったけど共感されるだろうな」というあるあるを教えてください
-
映画のエンドロール観る派?観ない派?
映画が終わった後、すぐに席を立って帰る方もちらほら見かけます。皆さんはエンドロールの最後まで観ていきますか?
-
海外旅行から帰ってきたら、まず何を食べる?
帰国して1番食べたくなるもの、食べたくなるだろうなと思うもの、皆さんはありますか?
-
天使と悪魔選手権
悪魔がこんなささやきをしていたら、天使のあなたはなんと言って止めますか?
-
エクセルの1シートの内容を複数のシートに分割したい。
Excel(エクセル)
-
エクセルで50行ごとに区切ったデータをシートに分割したい
Excel(エクセル)
-
EXCEL、マクロ-改ページ行番号の取得方法を教えてください
Visual Basic(VBA)
-
-
4
パワーポイントをエクセルファイルへ
PowerPoint(パワーポイント)
-
5
EXCELで2つの数値のうち大きい方を採択する数式
Excel(エクセル)
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルの選択範囲以外を削除...
-
Excel 関数を使ってデータと一...
-
EXCELのVBAでシートコピーをし...
-
【Excel VBA】シートコピー時、...
-
Excel シートのコピーの際、ペ...
-
EXCELで別のブックから式をコピ...
-
【VBA】コピー&複数個所のペー...
-
VBA シートをコピー後、ボタン...
-
エクセルのワークシートをUSBメ...
-
エクセルの1シートの内容を複...
-
エクセルシートを別のエクセル...
-
エクセルVBA 1行飛ばしで転記す...
-
VBAにて複数フォルダのエクセル...
-
エクセルで、開くのに時間のか...
-
ExcelVBAで、ユーザーフォーム...
-
Excelの行をコピーして貼り付け...
-
エクセルのページをシートごと...
-
エクセルVBAですが教えてくださ...
-
エクセルでシートを「移動また...
-
フィルターをかけてCSV保存をVBAで
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルの選択範囲以外を削除...
-
Excel 関数を使ってデータと一...
-
EXCELのVBAでシートコピーをし...
-
Excelの行をコピーして貼り付け...
-
EXCELで別のブックから式をコピ...
-
【VBA】コピー&複数個所のペー...
-
Excel 数式の保護をしたセルを...
-
エクセルVBA 1行飛ばしで転記す...
-
エクセルの1シートの内容を複...
-
Excel シートのコピーの際、ペ...
-
エクセルでシートを「移動また...
-
エクセルの表を作ってるんですが
-
PDFファイルをコピーしてエクセ...
-
エクセルのワークシートをUSBメ...
-
エクセルのページをシートごと...
-
VBA シートをコピー後、ボタン...
-
【Excel】数式をそのまま他のシ...
-
アクセスの画面をプリントスク...
-
ExcelVBAで、ユーザーフォーム...
-
【Excel VBA】シートコピー時、...
おすすめ情報
よく確認したところ、画像自体の大きさが変わっているのではなくて、行の高さが元シートから変更されてしまっていて、それに付随して画像の縮尺が変わるなどの問題が起きているようでした。