View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
diverdon99 diverdon99 is offline
external usenet poster
 
Posts: 5
Default Split large sheet into several smaller sheets for emailing

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