View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
joel[_408_] joel[_408_] is offline
external usenet poster
 
Posts: 1
Default Breaking out rows of data, sequentially, into headered columns


Here is the updates. I added a page break after each page.

Sub FormatData()

Set SourceSht = Sheets(1)

FirstPageRow = 2
LastPageRow = 58

NewRowCount = FirstPageRow
NewColCount = 3

With SourceSht
With .Cells.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
End With

'If data start i A1 then add new row
If .Range("A1") < "Inst. No." Then
.Rows(1).Insert

.Range("A1") = "Inst. No."
.Range("B1") = "Memo"
End If

.Range("C1") = "Inst. No."
.Range("D1") = "Memo"

RowCount = 59
Do While .Range("A" & RowCount) < ""
If NewRowCount LastPageRow Then
NewColCount = NewColCount + 2
'create new sheet

If NewColCount 8 Then
'add page break
ActiveWindow.SelectedSheets.HPageBreaks.Add _
Befo=.Range("A" & (LastPageRow + 1))
NewColCount = 1
FirstPageRow = FirstPageRow + 58
LastPageRow = LastPageRow + 58
End If

.Cells(FirstPageRow - 1, NewColCount) = "Inst. No."
.Cells(FirstPageRow - 1, NewColCount + 1) = "Memo"

NewRowCount = FirstPageRow
End If

.Cells(NewRowCount, NewColCount) = _
.Range("A" & RowCount)

NewRowCount = NewRowCount + 1
RowCount = RowCount + 1
Loop

LastRow = .Range("A" & Rows.Count).End(xlUp).Row

If NewColCount = 1 Then
.Rows(NewRowCount & ":" & LastRow).Delete
Else
.Rows((LastPageRow + 1) & ":" & LastRow).Delete
End If
End With
End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=165111

Microsoft Office Help