Macro for setting print area based on last used row across multiple worksheets in a workbook.

[JKWyo]

I've been beating up google for the last few days trying to compile this macro for my workbook without any luck. Some codes that work, only do the current worksheet and others don't get off the ground. I need to set the print area to be the last filled row in each worksheet for when I use another macro to save each worksheet as a pdf, it doesn't print extra sheets or split the columns. This is one macro that I have found that partly gets what I want, but it is limited to the current page:

Sub PageSetup
Dim LastRow As Long
Dim LastCol As Long
Dim myRng As Range
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set myRng = .Range("A1", .Cells(LastRow, LastCol))
.PageSetup.PrintArea = myRng.Address(external:=True)
End With
End Sub

I'd like it to work across every worksheet in the book. I'm a rookie with scripting and everything I tried to change has failed. Any help will be greatly appreciated!

 

[Gavin T]

This loops through each sheet in your workbook.

Sub PageSetup()

    Dim LastRow As Long
    Dim LastCol As Long
    Dim myRng   As Range
    Dim ws      As Worksheet

    For Each ws In ThisWorkbook.Worksheets
        With ws
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
            Set myRng = .Range("A1", .Cells(LastRow, LastCol))
            .PageSetup.PrintArea = myRng.Address(external:=True)
        End With
    Next ws

End Sub

 

[JKWyo]

This loops through each sheet in your workbook.

Sub PageSetup()

    Dim LastRow As Long
    Dim LastCol As Long
    Dim myRng   As Range
    Dim ws      As Worksheet

    For Each ws In ThisWorkbook.Worksheets
        With ws
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
            Set myRng = .Range("A1", .Cells(LastRow, LastCol))
            .PageSetup.PrintArea = myRng.Address(external:=True)
        End With
    Next ws

End Sub

Gavin- Thank you for taking the time to help me out. When I tried that statement earlier, it would stop at the "With" for some reason... The fix is greatly appreciated!

I added it the other macros that I found and compiled to make the formatting process easier. What took 2-3 hours to complete now takes ~ 90 seconds. This group of macros first finds and replaces text, and then parses data based on a column's data into their respective worksheets (68 in my case). It then autofits the column widths, sets the print area based on last row, and prints the files to pdf to be on one page.

Again- Thanks for your help.

Sub SplitData()
Const NameCol = "D"
Const HeaderRow = 1
Const FirstRow = 2
Dim SrcSheet As Worksheet
Dim TrgSheet As Worksheet
Dim SrcRow As Long
Dim LastRow As Long
Dim TrgRow As Long
Dim Student As String
Application.ScreenUpdating = False
Set SrcSheet = ActiveSheet
LastRow = SrcSheet.Cells(SrcSheet.Rows.<wbr>Count, NameCol).End(xlUp).Row
For SrcRow = FirstRow To LastRow
Student = SrcSheet.Cells(SrcRow, NameCol).Value
Set TrgSheet = Nothing
On Error Resume Next
Set TrgSheet = Worksheets(Student)
On Error GoTo 0
If TrgSheet Is Nothing Then
Set TrgSheet = Worksheets.Add(After:=<wbr>Worksheets(Worksheets.Count))
TrgSheet.Name = Student
SrcSheet.Rows(HeaderRow).Copy Destination:=TrgSheet.Rows(<wbr>HeaderRow)
End If
TrgRow = TrgSheet.Cells(TrgSheet.Rows.<wbr>Count, NameCol).End(xlUp).Row + 1
SrcSheet.Rows(SrcRow).Copy Destination:=TrgSheet.Rows(<wbr>TrgRow)
Next SrcRow
Application.ScreenUpdating = True
End Sub
Sub Adjustcolumnswidth()
For Each WS In Worksheets
WS.Columns.AutoFit
Next WS
End Sub
Sub saveEachSheetAsPdf()


Dim sht As Worksheet
For Each sht In ThisWorkbook.Worksheets
sht.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="C:\Users\temp\" & sht.Name & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=False
Next sht
End Sub
Sub PageSetup()


Dim LastRow As Long
Dim LastCol As Long
Dim myRng As Range
Dim WS As Worksheet


For Each WS In ThisWorkbook.Worksheets
With WS
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).<wbr>Column
Set myRng = .Range("A1", .Cells(LastRow, LastCol))
.PageSetup.PrintArea = myRng.Address(external:=True)

End With
Next WS


End Sub
Sub Printwidth()


With ActiveSheet.PageSetup
.PrintTitleRows = "$3:$3"
.PrintTitleColumns = "$B:$B"
.Zoom = False
.Orientation = xlLandscape
.FitToPagesWide = 1
.FitToPagesTall = 1
If .Zoom < 30 Then .Zoom = 50
End With


End Sub
Sub Chgtraining()

Dim WS As Worksheet
Dim Search As String
Dim Replacement As String
Dim Prompt As String
Dim Title As String
Dim MatchCase As Boolean

Prompt = "What is the original value you want to replace?"
Title = "Search Value Input"
Search = InputBox(Prompt, Title)

Prompt = "What is the replacement value?"
Title = "Search Value Input"
Replacement = InputBox(Prompt, Title)

For Each WS In Worksheets
WS.Cells.Replace What:=Search, Replacement:=Replacement, _
LookAt:=xlPart, MatchCase:=False
Next

End Sub
Sub ChgCertification()

Dim WS As Worksheet
Dim Search As String
Dim Replacement As String
Dim Prompt As String
Dim Title As String
Dim MatchCase As Boolean

Prompt = "What is the original value you want to replace?"
Title = "Search Value Input"
Search = InputBox(Prompt, Title)

Prompt = "What is the replacement value?"
Title = "Search Value Input"
Replacement = InputBox(Prompt, Title)

For Each WS In Worksheets
WS.Cells.Replace What:=Search, Replacement:=Replacement, _
LookAt:=xlPart, MatchCase:=False
Next

End Sub
Sub Master()


Call ChgCertification
Call Chgtraining
Call SplitData
Call Adjustcolumnswidth
Call PageSetup
Call Printwidth
Call saveEachSheetAsPdf
End Sub

 

[Gavin T]

Glad I could help.