Don
Try this
Sub Make_Reports()
Dim iReport As Long
Dim lRow As Long
Dim wsReport As Worksheet
Dim wsData As Worksheet
iReport = 1
lRow = 2 'assumes first row is header row
Set wsData = ActiveSheet
Do While Not IsEmpty(wsData.Cells(lRow, 1))
With wsData
If .Cells(lRow, 1).Value < _
.Cells(lRow, 1).Offset(-1, 0).Value Then
'add new worksheet for new report
Set wsReport = Worksheets.Add
wsReport.Name = "Report " & .Cells(lRow, 1).Value
'copy headers
.Range("A1:J1").Copy _
Destination:=wsReport.Range("A1")
End If
.Cells(lRow, 1).EntireRow.Copy _
wsReport.Range("A65536").End(xlUp).Offset(1, 0)
End With
lRow = lRow + 1
Loop
End Sub
--
Dick Kusleika
MVP - Excel
www.dicks-clicks.com
Post all replies to the newsgroup.
"diverdon99" wrote in message
...
I need to split large datasheet (over 20,000 rows) into separate
worksheets,
which will then be emailed to individuals.
My problem that the data is in 10 columns and col 1 may contain from 1 to
95
items that are identical in the first cell.
What I need is the ability to compare A2 with A3 and if the same then A4
with A3 and so on until A(x) is compared with the previous cell and at
that
point create a new worksheet.
An additional nice touch would be to name the worksheet with the contents
of
the cell A1 and subsequent data changes.
Example data:
A B C
1 Fred Dog Cat
2 Fred Fish Apple
3 Joe Item1 Item2
4 Joe Item1 Item3
5 Joe Item 2 Item3
In this case a new Worksheet would be created between Fred and Joe.
I have used the code below from another post that does part of this but am
stuck on the rest.
Sub Make_Reports()
Dim iReport As Integer
Dim lRow As Long
Dim wsReport As Worksheet
Dim wsData As Worksheet
'speed things up a bit
Application.ScreenUpdating = False
iReport = 1
lRow = 2 'assumes first row is header row
Set wsData = ActiveSheet
Do While wsData.Cells(lRow, 1).Formula < ""
'add new worksheet for new report
Set wsReport = Worksheets.Add
wsReport.Name = "Report " & iReport
'copy headers
wsData.Range("A1:J1").Copy _
Destination:=wsReport.Range("A1")
'copy data (25 rows * 10 columns
wsData.Cells(lRow, 1).Resize(25, 10).Copy _
Destination:=wsReport.Range("A2")
End Sub
Thanks in advance for all your help
Don