Split Sheet

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I have a program that dumps over 6000 lines of data into an excel
spreadsheet. I have managed to use vba to insert page breaks at various
points in the spreadsheet where header information is repeated. Now I'd like
to somehow divide this 1 sheet into multiple sheets with each page break
being a new sheet. I'd also like to have it give each sheet a specific name
by pulling a word out of cell that contains a specific word. Is this
possible with vba? Can anyone help get me started. Thanks.
 
It seems to have a problem when it comes to i - 1 at

ReDim Preserve HorzPBArray(1 To i - 1)

and

curWks.Rows(TopRow & ":" & HorzPBArray(i) - 1).Copy
Destination:=newWks.Range("a1")

If I change it to +1 the code seems to execute with error I just don't get
the results I want. This also seems to put each page break into a new
workbook. I want all the sheets to appear in the current workbook if
possible. Thanks.
 
I put the code into a different workbook than my worksheet, and I got this
error. But it was related to the ThisWorkbook.Names.add line.

And I missed the last page using the existing routine. So I added a horizontal
page break after the last used row.

Option Explicit
Sub testme01()

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

Set curWks = ActiveSheet
With curWks
.DisplayPageBreaks = False
.HPageBreaks.Add before:=.Cells.SpecialCells(xlCellTypeLastCell) _
.Offset(1, 0).EntireRow.Cells(1)

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

ActiveWorkbook.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)

TopRow = 1
For i = LBound(HorzPBArray) To UBound(HorzPBArray)
Set newWks = Worksheets.Add
curWks.Rows(TopRow & ":" & HorzPBArray(i) - 1).Copy _
Destination:=newWks.Range("a1")
TopRow = HorzPBArray(i)
Next i

End Sub

From my first post:
This one adds a new worksheet per "page".
 
This worked absolutely perfectly, just like I had asked. Thanks so much.
The only issue I hadn't considered is that it creates a new sheet for every
horizontal page break, not just the ones I inserted. Is there anyway to tell
it to distinguish between a hard page break (one that I forced with vba)
versus all page breaks? Thanks again for the help.
 
Just the manual page breaks?

Option Explicit
Sub testme01()

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

Set curWks = ActiveSheet
With curWks
.DisplayPageBreaks = False
.HPageBreaks.Add before:=.Cells.SpecialCells(xlCellTypeLastCell) _
.Offset(1, 0).EntireRow.Cells(1)
End With

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

ActiveWorkbook.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)

TopRow = 1
For i = LBound(HorzPBArray) To UBound(HorzPBArray)
If curWks.Rows(HorzPBArray(i)).PageBreak = xlPageBreakManual Then
Set newWks = Worksheets.Add
curWks.Rows(TopRow & ":" & HorzPBArray(i) - 1).Copy _
Destination:=newWks.Range("a1")
TopRow = HorzPBArray(i)
End If
Next i

End Sub

There was an error in my earlier post. I dropped an "end with", but it sounds
like you got it working ok.

My question. Are you breaking up a list based on a certain column. When it
changes, then create a new sheet?

If you are, you may want to use a different technique than manually inserting
page breaks.


Maybe you can steal some code from Debra Dalgleish's site:
http://www.contextures.com/excelfiles.html

Create New Sheets from Filtered List -- uses an Advanced Filter to create
separate sheet of orders for each sales rep visible in a filtered list; macro
automates the filter. AdvFilterRepFiltered.xls 35 kb

Update Sheets from Master -- uses an Advanced Filter to send data from
Master sheet to individual worksheets -- replaces old data with current.
AdvFilterCity.xls 55 kb
 
I have an invoice file that is one workheet of 200+ pages, I need them in
their own files named by their corresponding access unique id for me to dump
them into the DB and then upload to our website. This code works perfect for
splitting according to the horizontal page breaks and then saving each page
as a new file. Two problems I am really stumped on:

1) I need to have the formatting stay the same from the parent to the new
file. I am using xl 2003. I found some code from Ron DeBruin's site but am
not sure where to put it or if it is what I need...

If you run the code in Excel 2007 it will look at the FileFormat of the
parent workbook and save the new file in that format. Only if the parent
workbook is an xlsm file and if there is no code in the new workbook it will
save the new file as xlsx, If the parent workbook is not an xlsx, xlsm, or
xls then it will be saved as xlsb.

This are the main formats in Excel 2007 :

51 = xlOpenXMLWorkbook (without macro's in 2007, xlsx)
52 = xlOpenXMLWorkbookMacroEnabled (with or without macro's in 2007, xlsm)
50 = xlExcel12 (Excel Binary Workbook in 2007 with or without macro’s, xlsb)
56 = xlExcel8 (97-2003 format in Excel 2007, xls)

Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select

2) I also need to have the file name come from a value in a cell on each
page rather than from the page number. I will make sure that the proper
unique id from each page ends up in cell "A1" so I want the name of the file
to be the data in cell A1.

Thanks for your help,

Amy


Option Explicit
Sub testme01()

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
curWks.Rows(TopRow & ":" & horzPBArray(i) - 1).Copy
Destination:=newWks.Range("a1")
newWks.Parent.SaveAs Filename:="C:\Documents and Settings\amy\My
Documents\" & "Page" & i, FileFormat:=xlWorkbookNormal
TopRow = horzPBArray(i)
Next i

newWks.Parent.Close savechanges:=False

End Sub
 
I don't, I just need to keep the formatting the same as in the original file,
but don't know what to change the "FileFormat:=xlWorkbookNormal" line to in
order to make that happen. Your stuff is the only place I could even find
mention of formatting at all. Any ideas about the file name...
 
I think I may have found a code to rename all of the files in the folder
using the A1 cell. Still need help with the formatting line.

Thanks
 
I don't, I just need to keep the formatting the same as in the original file

You do a normal copy so it will copy formatting
Do you miss the row height and column width ?
Or are other things important ?

Let me know and I will help

See also this page for sheets
http://www.rondebruin.nl/hpagebreaks.htm
 
This has worked perfect in Excel 2003 for a number of years but now I'm
getting an Error 9 at the line...

ReDim Preserve HorzPBArray(1 To i - 1)

This error seems to correspond with the upgrade to Excel 2007. Why is it no
longer working and what alternate coding can be used?
 
Do you have any horizontal pagebreaks in that worksheet?

If you add:
msgbox i
right before the offending line, what do you see?
 
Yes, several hundred.

Dave Peterson said:
Do you have any horizontal pagebreaks in that worksheet?

If you add:
msgbox i
right before the offending line, what do you see?
Click to expand...
 
And what do you see in the msgbox?

(I don't have a guess why that line causes an error.)
 
The error message that pops up is...

Run-time error '9':
Subscript out of range
<End> <Debug> <Help>

When I click Debug it takes me to the ReDim Preserve HorzPBArray(1 To i - 1)
line.
 
What do you see in the msgbox that shows what i is?

msgbox i

right before the offending line.
 
Back
Top