Excel で一つのシートを２枚に分けて印刷

質問

Excel マクロは私にとっていばらの道です。

__________A______B_____C_____D
1_______名前____金額__日付__摘要
2______あああ__55555___6___ｋｋｋ
3______いいい__________6___ｈｈｈ
4______ううう__33333___6___ｐｐｐ
---------------------------------
5______えええ__44444___8___ｇｇｇ
6______おおお__77777___8___ｌｌｌ
7______あいう__22222___8___ｒｒｒ

一つのシートを、A2:D4 と　A5:D7 の２枚に分けて印刷するマクロを作りたいと考えています。

A1:D1の項目行は、「印刷タイトル」に設定してあります。
金額は空欄の場合もありますが、A名前、C日付とD摘要は連続です。
データ行は増えたり減ったりし、一定ではありません。

日付けの変わるところが印刷区分です。この日付の変わり目をつかまえて印刷範囲を指定できると思っていますが、なかなか巧くいきません。
印刷区分は、範囲設定でなく、ページ区分でもかまいません。

なるべく行数の少ないスカッとしたマクロにするにはどうしたらよいでしょうか。
教えて下さい。よろしくお願いします。

回答No.2

pkh4989 · ベストアンサー

こんにちは。

見出しもマクロで設定します。お試しください。

Sub 印刷()
　　Dim wR　　 As Long
　　Dim maxR　　As Long
　　With ActiveSheet
　　　　maxR = .Range("A" & Rows.Count).End(xlUp).Row
　　　　For wR = 3 To maxR
　　　　　　If .Cells(wR, 3).Value <> Cells(wR - 1, 3) Then
　　　　　　　　'日付が変わる時、改頁の Break Point設定
　　　　　　　　.Rows(wR).PageBreak = xlPageBreakManual
　　　　　　End If
　　　　Next
　　End With
　　With ActiveSheet.PageSetup
　　　　.PrintTitleRows = "$1:$1"　　 '←1行見出し
　　　　.PrintArea = "A1:D" & maxR　　 '←印刷範囲設定
　　End With
　　ActiveSheet.PrintOut
End Sub

お礼

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

補足

pkh4989さん　ありがとうございます。
実際はもう少し大きい表で、編集したいので教えて下さい。

> For wR = 3 To maxR
> If .Cells(wR, 3).Value <> Cells(wR - 1, 3) Then

> .PrintTitleRows = "$1:$1"

これは見出し行が２行、日付が列 E にある場合次のようにしてよいですか。

　For wR = 4 To maxR
If .Cells(wR, 5).Value <> Cells(wR - 1, 5 ) Then

.PrintTitleRows = "$1:$2"

表の下に、別の記事がある場合、印刷を表の部分のみで終わりにするとき、どうしたらよいですか。

よろしくお願いします。

回答No.3

pkh4989

こんにちは。

>これは見出し行が２行、日付が列 E にある場合次のようにしてよいですか。
>　For wR = 4 To maxR
>If .Cells(wR, 5).Value <> Cells(wR - 1, 5 ) Then
>
>.PrintTitleRows = "$1:$2"
OKです

>表の下に、別の記事がある場合、印刷を表の部分のみで終わりにするとき、どうしたらよいですか。
行の最大を求めるのはA列ですので、「別の記事」がA列のなければ、大丈夫です。

お礼

pkh4989さん　ありがとうございます。
別の記事をＢ列より右に移して巧くいきました。

なお、前に使ったページ区分を引きずらないよう、冒頭に「印刷範囲クリア」のコードを入れました。
ActiveSheet.PageSetup.PrintArea = ""

回答No.1

misatoanna

> A1:D1の項目行は、「印刷タイトル」に設定してあります。
という前提です。
Ｃ列が日付欄として、日付の変わり目に改ページを挿入します。

Sub Test()
　Dim i
　i = 3
　Do Until Cells(i, 3) = ""
　　If Cells(i, 3).Value <> Cells(i - 1, 3) Then
　　　Rows(i).Select
　　　ActiveWindow.SelectedSheets.HPageBreaks.Add _
　　　　　　　　　　Before:=ActiveCell
　　End If
　　i = i + 1
　Loop
　'ActiveSheet.PrintOut
End Sub

１行目はタイトル行、データが２行目からですので、３行目の日付が２行目と
同じかどうか、からチェックを開始しています。
違っていたら、その行を選択して改ページを挿入します。

お礼

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

補足

misatoannaさん　ありがとうございます。
質問の条件が書ききれていませんでした。

表の右にも下にも別の記事があって、表の部分だけを２枚に抜き出して印刷したいのです。
よろしくお願いします。