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 Befo=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



--
Thanks,
PTweety

Try

Set ActiveSheet.PageSetup.PrintArea = wksTemp.PageSetup.PrintArea.Address

--
Steve

"pickytweety" wrote in message
...
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 Befo=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



--
Thanks,
PTweety

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

"pickytweety" wrote:

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 Befo=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



--
Thanks,
PTweety