Dynamic Print Ranges

[deve8ore]

Hello, I have a workbook with ~ 20 sheets, all which upload with different data every week. We have some "old school" managers that are still requesting hard copies of each sheet.... problem for me is that the ranges per sheet can change dramatically (I.e. - from (A1:D20) to (C1:Z490).

So far I've tried to create print ranges based on the number of cell functions, and try to print, however the font in some pages can be very small... some pages will print an extra four blank pages..... so obviously not working properly.

Is there a somewhat easy code that can determine the length and width of populated cells and consistently print?

So far I've put together the following which is not working like it should:

Sub Excluded()
Sheets("Excluded Claims").Select
ActiveSheet.PageSetup.PrintArea = ([ExclusionsPrint])
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$7"
.PrintTitleColumns = ""
End With
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Range("A1").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End Sub

I know it states 1 page by 1 page, however if I put 1 page by 10, it still comes out to 14+ pages, with several blank. I'm thinking theres a much easier way to accomplish this.

Thanks to anyone who can help!