- ベストアンサー
VBAで別シートに改ページをして印刷する
pkh4989の回答
細かい部分までは書けないが、こんな具合かな～ 別のブックへ移動しても設定した改ページは保持されると思いますよ。 Sub test() With Worksheets("Sheet1") ' wR = 0 Exitflg = False Do '・・・小計処理(小計する条件が満たすまで) wR = wR + 1 subTot = subTot + .Cells(wR, 3) ' ' With Worksheets("Sheet2") '・・・sheet2に小計値セット wR = wR + 1 .Cells(wR, 3) = subTot '・・・改ページを挿入 .HPageBreaks.Add Before:=.Range("A" & wR + 1) '・・・合計処理 allTot = allTot + subTot subTot = 0 End With ' ' '・・・小計処理終了の時 Exitflg = True Loop Until Exitflg = True '・・・合計値出力 wR = wR + 1 .Cells(wR, 3) = allTot End With End Sub
関連するQ&A
- vba 特定の複数シートを別ファイルで保存。
ブック内にA,Bと２つのシートがあり、ボタンをクリックすると特定の回数、シートAの情報が新規作成されたシートCにコピーされ、シートCとシートBの２シートが別ファイルとして保存される。という動きを繰り返したいのですが、 新規生成されるシートCだけを別ファイルで保存することまでは出来たのですが、シートBが追加できず困っています。 Sub 分割() Dim cpy As Range Dim pst As Range Dim path 'ファイルパス path = ActiveWorkbook.path Dim CopyWorkBook Dim CopyWorkSheet1 Dim CopyWorkSheet2 Dim Position(2,2) 'ここにはシートCを作成する際の情報が入っている。 '新規シートCを作成してシートAからデータをコピー。 For i = 1 To 2 Step 1 'とりあえず２シート作成する。 Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = Position(i, 2) 'まずは、タイトル欄をコピー Worksheets("Sheet1").Activate Set cpy = Worksheets("Sheet1").Range("A2:Q2") Worksheets(Position(i, 2)).Activate Set pst = Worksheets(Position(i, 2)).Range("A2:Q2") pst.Value = cpy.Value '貼り付け End With 'シートを別名で保存 Set CopyWorkSheet1 = Worksheets(Position(i, 2)) Set CopyWorkSheet2 = Worksheets("シートB") CopyWorkSheet1.Copy ' CopyWorkSheet2.Copy ←これでシートBもコピーされるかと思いましたが、シートBが上書きされてしまう。 Set CopyWorkBook = ActiveWorkbook ActiveWorkbook.SaveAs path & "\" & Position(i, 2) & "xls", xlWorkbookNormal CopyWorkBook.Close Next End Sub 質問は２つあります。 (1)シートBも新規作成されたシートCと一緒に別ブックに保存したいのですが、どうすればいいでしょうか？ (2)シートのコピーの動きがイマイチよくわかりません。 今の私の環境だと（ネットで調べた書き方ですが）、シートを別ブックにコピーする際、 Set CopyWorkSheet1 = Worksheets("シートA") CopyWorkSheet1.Copy Set CopyWorkBook = ActiveWorkbook となっていますが、Setで、コピー元のシートAの情報をCopyWorkSheet1にコピーしたあと、 CopyWorkSheeet1.Copy となっていますが、この意味がわかりません。 なぜ更にコピーしているのでしょうか？またこれで、別ブックにシートが追加されてる理由もわかりません。 また、この処理の後に、 Set CopyWorkBook = ActiveWorkbook と、ブックの情報をコピーしていますが、普通に考えると最初にブックの情報をコピーして別名のブックを生成しておく必要があるように思えるのですが、後でよい理由も分かりませんし、これだと、Activeのワークブックのシート情報も全部コピーされてしまう気がするのですが。。。 この辺が全然分かっていないので、解説頂けるか参考サイトを教えて頂けないでしょうか。 よろしくお願い致します。
- ベストアンサー
- Excel（エクセル）
- EXCEL-VBAで印刷時のページ番号を取得したい
EXCEL97です。 ブックの目次を作るマクロを作っています。 ブック内のシート名を目次のシートに縦に並べることはできたのですが、 その横にセットしたページ数をどうやって取得するか悩んでいます。 過去ログも見たのですがHPageBreaks.Countでは プレビューでは１ページしかないはずのシートで １が返ってきたりしてどうもうまくいきません。 良い方法があればどなたか教えてもらえないでしょうか。
- ベストアンサー
- オフィス系ソフト
- エクセル VBA シート名を別シートにコピー
早速の質問ですが エクセルVBAで シート名を別シートにコピーなのですが 10個のシートを順にシート名をコピー＆ペーストしたいのです。 Dim aworkbook As Workbook Dim bworkbook As Workbook Set bworkbook = ActiveWorkbook Workbooks.Add Set aworkbook = ActiveWorkbook for i=1 to 10 bworkbook.Activate Worksheets(i).Select Application.CutCopyMode = False aworkbook.Activate Worksheets(i).Select ここに入る文章がわかりません Range("A1").Select next と以上な感じで作ってみたのですが どう貼り付けして良いかわからない状況です nextでまわす以上変数でなければだめなんでしょうけれども 構文が思いつきません。 皆様よろしくお願いいたします。
- 締切済み
- オフィス系ソフト
- エクセルVBAについて
＜sheet1＞フォーマット（コピーするシート） ＜sheet2＞ A列 B列 ○○支店 15 △△支店 10 ××支店 28 ■■支店 25 ◎◎支店 18 sheet1のフォーマットをsheet2のB列の数コピーして、sheet2のA列の支店別に新しいブックへ保存するという作業のマクロを組みたいのですがどのようにしたらよいでしょうか？お教えください。VBAに関しまして初心者で、勉強しているのですがいまいちわかりません。どうぞよろしくお願いします。 今、一つだけコピーして保存するということはできていますが、上記のように全部を自動的にしたいのですが・・・ Sub グラフをコピーして別ブックへ保存() Dim mySheet As Worksheet Set mySheet = ActiveWorkbook.Worksheets("グラフ") mySheet.Copy ActiveWorkbook.SaveAs Filename:="大阪第一" '別名を付けてブックを保存する ActiveWorkbook.Close '別名ブックを閉じる End Sub よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- VBAで別ブックのシートを指定して削除したい。
VBAで別ブックのシートを指定して削除したい。 エクセルでVBAを使用して、別ブックのシートを削除するアプリを作成しています。 これらのマクロを記述するエクセルとは別ブックのシートを削除したいです。 以下の記述だと、削除がされないようなのですがどのように記載したら 別ブックのシートを削除することが可能でしょうか。 エラー等は出ません。また、別ブックの情報も取ってこれているようですが、 削除ができません。。 どなたか教えてください。 'Excelを起動し、ファイルを開く Set xl = CreateObject("Excel.application") xl.Workbooks.Open fileName:=fileFullPath, ReadOnly:=False, IgnoreReadOnlyRecommended:=True '※fileFullPathがオープンするエクセルファイルです。 '"一覧"シートの1列目に「公開時削除」という文字が入っている行の2列目のテーブル名を取得 'シートの削除 Application.DisplayAlerts = False xl.ActiveWorkbook.Worksheets(deleteTableName).Delete Application.DisplayAlerts = True '※deleteTableNameは削除したいシートの名前が入ります。
- ベストアンサー
- Visual Basic
- 【VBA】全てのｼｰﾄを並び替え 反映せず
For Each Ws In Worksheets Ws.Activate 「並び替えの処理」 Next Ws を記述したのですが、 「並び替えの処理」を記憶ﾏｸﾛからｺﾋﾟﾍﾟした為、 ("Sheet1")しか並び替えの処理がされません。(全ｼｰﾄ並び替えの処理がしたい) 下記ｺｰﾄﾞをどの様に修正すれば良いでしょうか。 ご教示願います。 '5行目から最終行迄範囲選択し、Ｗ列で昇順に並び替え Rows("5:5").Select Range(Selection, Selection.End(xlDown)).Select ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("W5:W40") _ , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("Sheet1").Sort .SetRange Range("A5:X40") .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With
- 締切済み
- Excel（エクセル）
- Excel VBA 指定シートの取込
こんにちは。 ExcelのVBAを使用して、異なるBookのシートを取込みたいのですが、 シートが無かった場合の処理方法がわかりません。 現在のコードは下記の様になっております。 With Workbooks.Open"BOOK1.xls" .Worksheets("Sh1").Cells.Copy ThisWorkbook.Sheets("Sheet1").Range("A1") .Worksheets("Sh2").Cells.Copy ThisWorkbook.Sheets("Sheet2").Range("A1") .Worksheets("Sh3").Cells.Copy ThisWorkbook.Sheets("Sheet3").Range("A1") .Close End With Book1に指定したシートが無い場合、何もしないようにしたいのですが、 どの様に書き換えれば宜しいでしょうか？ よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- Excel VBA 非表示の別ブックへシートコピー
Excel2010のVBAで、別のExcelブックを非表示で開いて、 シートをコピーすると、 「実行時エラー'1004':WorksheetクラスのCopyメソッドが失敗しました。」 というエラーが出て、正しくシートをコピーすることができません。 (1)のように自分のブックへはシートをコピーすることはできるのですが、 (2)のように別のExcelブック上でシートをコピーする場合と (3)のように別のExcelブック上にシートをコピーする場合の いずれも同様のエラーになります。 どのように記述すれば(2)と(3)でもコピーすることができるのでしょうか。 ------------------------------------------------------------- Sub test() Dim newEx As Excel.Workbook Dim newFile As String newFile = ThisWorkbook.Path & "\New_Book.xlsx" Set newEx = Workbooks.Open(newFile, UpdateLinks:=0) Application.Windows("New_Book.xlsx").Visible = False '(1)New_BookのSheet3を自分のブックにコピーする (正常) newEx.Worksheets("Sheet3").Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) '(2)New_BookのSheet3をNew_Bookにコピーする (エラー) newEx.Worksheets("Sheet3").Copy after:=newEx.Sheets(newEx.Sheets.Count) '(3)自分のブックのSheet3をNew_Bookにコピーする (エラー) ThisWorkbook.Worksheets("Sheet3").Copy after:=newEx.Sheets(newEx.Sheets.Count) Application.Windows("New_Book.xlsx").Visible = True Application.DisplayAlerts = False newEx.Save newEx.Close Application.DisplayAlerts = True Set newEx = Nothing End Sub -------------------------------------------------------------
- 締切済み
- Excel（エクセル）
- エクセルVBAで別ブックの条件検索
VBA初心者です。エクセルは2007です。 『データのあるブック（Book1,Book2,Book3）』と、『検索条件シート+出力先シートをもつブック』の４つのブックがあります。 検索条件シートで、L22でブック、P22でシートを指定してN22に入力した数に対応するデータをVlookupで出力先シートのセルに抽出されるようにしたいのですが、※の部分で「エラー438 オブジェクトは、このプロパティまたはメソッドをサポートしていません」とでて実行できません。 データのあるブックは同じ形式でシートには表があります。 数 a b c d 1 A B C D 2 ○ × △ ■ 3 Z Y X W ・ ・ 検索条件がL22=3,P22=2,N22=2だとすると、Book3の２枚目のシートを検索し、 出力先シートのD1=○,J6=×,L23=△,J69=■となるようにしたいです。 本やインターネットで調べましたがわかりませんでした。 解決方法を教えていただきたいです。お願いします。 Sub 検索() Dim a, b, c, d As Range Dim 番号, ブック, シート As Integer With Workbooks("検索.xlsm").Sheets("検索条件") 数 = .Range("N22").Value ブック = .Range("L22").Value シート = .Range("P22").Value End With Dim wb As Workbook Dim sh As Worksheet Dim set範囲 As Variant With Workbooks("検索条件.xlsm").Sheets("出力先") Set a = .Range("D1") Set b = .Range("J6") Set c = .Range("L23") Set d = .Range("J69") End With Select Case ブック Case 1 Set wb = Workbooks("Book1.xlsm") wb.Activate Select Case シート Case 1 Set sh = Worksheets(1) Case 2 Set sh = Worksheets(2） Case Else MsgBox "・・・・・", vbExclamation, "nothing" End Select Case 2 Set wb = Workbooks("Book2.xlsm") wb.Activate Select Case シート Case 1 Set sh = Worksheets(1) Case 2 Set sh = Worksheets(2) Case Else MsgBox "・・・・・", vbExclamation, "nothing" End Select Case 3 Set wb = Workbooks("Book3.xlsm") wb.Activate Select Case シート Case 1 Set sh = Worksheets(1) Case 2 Set sh = Worksheets(2) Case Else MsgBox "・・・・・", vbExclamation, "nothing" End Select Case Else MsgBox "nothing", vbExclamation, "nothing" End Select ※Set set範囲 = wb.sh.Range("A4:E42") ←エラー438 a = Application.WorksheetFunction.VLookup(数, set範囲, 2, False) b = Application.WorksheetFunction.VLookup(数, set範囲, 3, False) c = Application.WorksheetFunction.VLookup(数, set範囲, 4, False) d = Application.WorksheetFunction.VLookup(数, set範囲, 5, False) End Sub
- ベストアンサー
- その他MS Office製品
- VBAでsheetのコピー
ご回答有難う御座いました。補足説明を致します。動作するとこまでは、出来たのですが、一点変更しました。：＝のコピーの所でデバッグすると、エラーになるので、＝だけにしました。すると動作するのですが、新しいsheetの名前が、コピー元のsheet名になります。そして、MsgBoxを入れると、エラーになります。また、1sheetだけがコピーされます。大変恐縮ですが、もう一度ご教授願います。補足説明なりますが、やりたい事は、拡張子がxlsmの中に名前のついた10個のsheetがあります。この10個のsheetを拡張子がxlsxのBookにコピーしたいのですが、このBook1のsheetをVBAから新に作成しBook2のsheet1に纏めたいのですが、纏め方は、Book2のsheet1の下から上に10sheetをコピーして、条件としてBook2のsheet1の名前は、固定で構いません。Book1の一番初めのsheetにコピーする時だけ3行目にある見出しだけは、Book2のsheet1に付けたく。それ以外のBook1のsheetは、デターだ4行目以降をコピーしたいのですが、また、コピーしたいsheetの範囲に列は、A1～AFで列は3～62までです。マクロはご教授頂いた、下記通りです。 Sub macro1() Dim i As Long Dim w0 As Workbook Dim s As Worksheet Set w0 = ActiveWorkbook '１枚目シートから貼り付け先のブックを作る w0.Worksheets(1).Copy Set s = ActiveSheet '２枚目以降のデータをコピーする For i = 2 To w0.Worksheets.count With w0.Worksheets(i) .Range("A4:AF" & .Range("A65536").End(xlUp).Row).Copy Destination = s.Range("A65536").End(xlUp).Offset(1) End With Next i End Sub これを先ほど書きました、マクロを教えて頂けませんでしょうか？何せ、マクロ初心者なので、msm相談箱がたよりです。何卒マクロを教えて頂きたく宜しくお願い申し上げます。
- ベストアンサー
- その他MS Office製品
お礼
ありがとうございます。 コードはご提示いただいたもので問題ありませんでした。 シートの設定で確認不足なところがあり、 うまく改ページがはいりませんでした。 現在は改ページ入るようになりました。 ありがとうございました