Try this code. It should work. fully tested


Sub formatData()

Set SourceSht = Sheets(1)

NewRowCount = 2
NewColCount = 3
SheetCount = 1
With SourceSht
'If data start i A1 then add new row
If .Range("A1") < "Inst. No." Then
.Rows(1).Insert

With Sheets(SheetCount)
.Range("A1") = "Inst. No."
.Range("B1") = "Memo"
With .Cells.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
End With
End With
End If

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

RowCount = 2
Do While .Range("A" & RowCount) < ""
If NewRowCount 58 Then
NewColCount = NewColCount + 2
'create new sheet
If NewColCount 8 Then
If SheetCount = Sheets.Count Then
'add new sheet
Sheets.Add after:=Sheets(Sheets.Count)
End If
SheetCount = SheetCount + 1
With Sheets(SheetCount).Cells.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
End With
NewColCount = 1
End If

With Sheets(SheetCount)
.Cells(1, NewColCount) = "Inst. No."
.Cells(1, NewColCount + 1) = "Memo"
End With
NewRowCount = 2
End If

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

NewRowCount = NewRowCount + 1
RowCount = RowCount + 1
Loop

'Delete data from sheet 1
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
If LastRow 58 Then
.Rows("59:" & 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