Get the print range from a sheet you just copied for use inthe new

P

pickytweety

Line 34 isn't right, so how do you get the same print range as the sheet you
just copied?


Sub PrepareReport()

Dim wksLoc As Worksheet
Dim wksTemp As Worksheet
Dim wksNew As Worksheet
Dim wksRight As Worksheet
Dim deptCell As Range
Dim deptLoop As Range
Dim blankstr As Variant ' row number of extra blank stores


Set wksLoc = Sheets("Locations")
Set wksTemp = Sheets("Template")
Set wksRight = Sheets("Right")


'Select the list of depts
With wksLoc
Set deptLoop = .Range("c1", .Range("c1").End(xlDown))
End With


'Loop through each dept
For Each deptCell In deptLoop
With wksTemp
.Range("a5").Value = deptCell
dept = .Range("a5").Value
End With

'Create a new sheet for each dept
wksTemp.Copy Before:=wksRight
Set wksNew = ActiveSheet

Set ActiveSheet.PageSetup.PrintArea = wksTemp.PageSetup.PrintArea 'THIS
ISN'T RIGHT--HOW DO I GRAB THE PRINT RANGE FROM THE TEMPLATE SHEET?

With wksNew
'Name new worksheet to be dept:
.Name = Trim(dept)
'Replace formulas with values
.Cells.Copy
.Cells.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'Get rid of extra blank stores and set the print range
blankstr = Application.Match(0, .Range("a:a"), 0)

If IsError(blankstr) Then
Else
If blankstr > 1 Then
'.Rows("1:" & blankstr - 1).Name = "'" & .Name & "'!Print_Area"
NOT USING THIS BECAUSE GRABS EXTRA COLS FOR MONTHS THAT ARE STILL NOT
COMPLETED
.Rows(blankstr & ":" & .Rows.Count).Delete
Else
End If
End If
End With


Next deptCell

End Sub
 
F

FSt1

hi
here is something i did a while back. i don't like it but it does work. you
can get the idea and modify it to suit your prupose. print_area is treated by
excel as a named range but it treats it different from other named ranges
since each sheets can have it on print_area. if you check the name box, you
will see that only the Print_area of the active sheet show in the name box.
i'm not entirely sure exactly how excel keeps track of them all.

Dim r As Range
Sheets("sheet1").Activate
Application.Goto reference:="print_area"
Set r = Selection
Range("A1").Select
'MsgBox r.Address
Sheets("sheet2").Activate
ActiveSheet.PageSetup.PrintArea = r.Address

regards
FSt1
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top