Range Printing

[Helmut]

I have the following macro below which worked fine until I added this line:

Selection.Interior.Color = 13434879 ' see below

It then all of a sudden printed 12 pages instead of 6 pages with the extra
being just blank lines.

What must I do to ONLY print the PRINT RANGE "rng" which sets ok on the screen

Sub Out()

' various routines which work ok

' Subtotal

Range("A2").Select
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(4), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Cells.Select

' make subtotal lines BOLD

ActiveSheet.Outline.ShowLevels RowLevels:=2
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Font.Bold = True
Selection.Interior.Color = 13434879
ActiveSheet.Outline.ShowLevels RowLevels:=3


' Autofit column width

Cells.EntireColumn.AutoFit
Range("A2").Select

' Print

' Dim lastrow As Long, rng As Range (put in declarations)
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Set rng = Range("A01" & lastrow)
rng.Select

ActiveSheet.PageSetup.LeftHeaderPicture.Filename = _
"\\shekel-srv\public\ù÷ì SHEKEL\LOGOonly.gif"
With ActiveSheet.PageSetup.LeftHeaderPicture
.Height = 77.25
.Width = 98.25
End With
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.CenterHeader = "&""-,Bold""&14øéëåæ ö'÷éí" & Chr(10) & "ùèøí ðôøòå"
.RightHeader = "&""-,Bold""&14ù÷""ì"
.CenterFooter = "òîåã &P òã &N"
.RightFooter = "&D"
.LeftMargin = Application.InchesToPoints(0.708661417322835)
.RightMargin = Application.InchesToPoints(0.708661417322835)
.TopMargin = Application.InchesToPoints(1.18110236220472)
.BottomMargin = Application.InchesToPoints(0.78740157480315)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.PrintHeadings = False
.PrintGridlines = True
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
End With

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True

End Sub

 

[michael.beckinsale]

Hi Helmut,

Try changing this :

Set rng = Range("A01" & lastrow)

To This ;

Set rng = Range("A2" & lastrow)

Note l have changed to row 2 because you have set row 1 for titles on
each page, additionally there is not a row01

Regards

Michael

 

[Helmut]

Hi Michael,
I tried this, but still get 12 instead of 6 pages.
Please note that if I take out: Selection.Interior.Color = 13434879
then I do get only 6 pages. Color coding seams to do something but don't
know what. May I send you both my xl & code file?