Sub insertnewpage() rt = MsgBox("改ページ処理を実行します。よろしいですか?", vbOKCancel) If rt <> vbOK Then Exit Sub ActiveSheet.PageSetup.PrintArea = "" With ActiveSheet.PageSetup .PaperSize = xlPaperA3 .FitToPagesWide = 1 .FitToPagesTall = False .Orientation = xlLandscape .Zoom = False .LeftMargin = Application.InchesToPoints(0.4) .RightMargin = Application.InchesToPoints(0.4) End With Cells(1, 1).Activate current = 0 For i = 0 To 100 prev = current If current = 1 Then Exit Sub Cells.Find(What:="■", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _ .Activate current = ActiveCell.Row If current <= prev Then Exit Sub End If ActiveWindow.SelectedSheets.HPageBreaks.Add before:=ActiveCell Next i End Sub