View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Amy Amy is offline
external usenet poster
 
Posts: 165
Default Add line in existing macro to use template

Just in case anyone can use the information, I figured out exactly what I
needed!

Columns("H:H").ColumnWidth = 13.29
Columns("J:J").ColumnWidth = 4.5
curWks.Rows(TopRow & ":" & horzPBArray(i) - 1).Copy
Destination:=newWks.Range("a14")
newWks.PageSetup.LeftHeaderPicture.Filename = "S:\Logo
Files\SHINElogoMed.jpg"
newWks.PageSetup.LeftHeader = "&G"
newWks.PageSetup.TopMargin = Application.InchesToPoints(0.08)
newWks.PageSetup.HeaderMargin = Application.InchesToPoints(0.08)
newWks.PageSetup.BottomMargin = Application.InchesToPoints(0.5)
newWks.PageSetup.FooterMargin = Application.InchesToPoints(0.5)
newWks.PageSetup.LeftMargin = Application.InchesToPoints(1)
newWks.PageSetup.RightMargin = Application.InchesToPoints(0.5)
newWks.PageSetup.Zoom = 95

"Amy" wrote:

I have a macro that splits one sheet with many pages into individual files by
page numbers using the horizontal page break. It works perfectly. However, I
need it to either A - include the header (and margins) from the original file
when saving to the new file or B - use a template for the new files. I have
tried to use the repeat rows from the first page but that makes a big mess in
the new file. I have copied the macro below. Thanks for the help.

Amy


Sub SplitPages()

Dim horzPBArray()
Dim curWks As Worksheet
Dim newWks As Worksheet
Dim TopRow As Long
Dim i As Long

Set curWks = ActiveSheet
curWks.DisplayPageBreaks = False

ThisWorkbook.Names.Add Name:="hzPB", RefersToR1C1:="=GET.DOCUMENT(64,"""
& ActiveSheet.Name & """)"

ThisWorkbook.Names.Add Name:="vPB", RefersToR1C1:="=GET.DOCUMENT(65,"""
& ActiveSheet.Name & """)"

i = 1
While Not IsError(Evaluate("Index(hzPB," & i & ")"))
ReDim Preserve horzPBArray(1 To i)
horzPBArray(i) = Evaluate("Index(hzPB," & i & ")")
i = i + 1
Wend

ReDim Preserve horzPBArray(1 To i - 1)
Set newWks = Workbooks.Add(1).Worksheets(1)

TopRow = 1
For i = LBound(horzPBArray) To UBound(horzPBArray)
newWks.Cells.Clear
Columns("H:H").ColumnWidth = 13.29
curWks.Rows(TopRow & ":" & horzPBArray(i) - 1).Copy
Destination:=newWks.Range("a1")
newWks.Parent.SaveAs Filename:="S:\Amy\Invoices\test\" & "Page" & i,
FileFormat:=xlWorkbookNormal
TopRow = horzPBArray(i)
Next i

newWks.Parent.Close SaveChanges:=False

End Sub