View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Tom Ogilvy Tom Ogilvy is offline
external usenet poster
 
Posts: 27,285
Default Moving Vertical Page Breaks in Excel via VB

If column F needs a vertical pagebreak, you won't be able to move it to the
right

--
Regards,
Tom Ogilvy

"steveokur" wrote in message
om...
I have created code that incorporates multiple worksheets into one
overall worksheet.

The problem I am experiencing deals with Vertical Page Breaks. In the
final worksheet, 3 separate vertical page breaks are created. I cannot
figure out how to move them in code. I have tried recording a macro,
then copying the code, but that gives a run time error.

I need to move the vertical page break from after column F to after
column H.

I have included my code below for assistance.

Thanks - Steve

VB Code --

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

Sub Merge_Open_Issues()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Open Issues").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Application.ScreenUpdating = False
Set DestSh = Worksheets.Add
DestSh.Name = "Open Issues"
For Each sh In ThisWorkbook.Worksheets
If sh.Name < DestSh.Name Then
Last = LastRow(DestSh)
sh.Range("A1:H100").Copy
DestSh.Cells(Last + 2, 1).PasteSpecial xlPasteAll, ,
False, False
DestSh.Cells(Last + 2, 1).PasteSpecial (8), , False, False
sh.Range("A2:H100").AutoFilter Field:=7, Criteria1:="="
sh.Range("A1:H100").Copy
DestSh.Cells(Last + 2, 1).PasteSpecial xlPasteAll, ,
False, False
sh.Range("A2:H100").AutoFilter
End If
Next

Sheets("Open Issues").Rows.AutoFit
ActiveWindow.Zoom = 50
Worksheets(1).PageSetup.Orientation = xlLandscape

With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.37)
.RightMargin = Application.InchesToPoints(0.39)
.TopMargin = Application.InchesToPoints(0.54)
.BottomMargin = Application.InchesToPoints(0.55)
End With
Application.CutCopyMode = False
DestSh.Cells(1).Select
Application.ScreenUpdating = True
End Sub