My impatience got the best of me... This group is so empowering! Just in case
anyone else could use the info, I have posted back what I figured out to get
everything to work!
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
>
|
Similar Threads
