Hi

I put a request out a few days ago and I am attaching the macro script as
well so you can see where I am up to.

The problem is, if there is only one result returned for a particular staff
member, the script falls with a variable object error.

If there is more than 1 record, the script works fine. It just falls where
a single record is returned.

I am attaching the original message I sent as well as the script. PLease
note that Mike, the guy that helped me immensley witht his, has also doen a
few other things like auto summing which you will see in the script but not
in my original message.

Original message and help
================================================

Hi everyone

I run a report that creates a 7 coumn spreadsheet analysing staff time
through a week.

The last column (G) uses a staff code and is sorted in ascending order.

What I would like to do is to run a macro or program that will go through
the spreadsheet and create a new worksheet for each Staff code, naming the
worksheet exactly the same, and inserting all the rows of data belonging to
each staff code into its individual worksheet.

For instance, if one of the Staff codes in the original pages is TW and
there are 9 rows of data for TW, I would like a worksheet inserted called TW
and then all those 9 rows of data copied into it from say Row B. In the main
sheet there are a load of heading in row A which ideally could also be copied
into Row A of each worksheet.

As much detail as possible would be really appreciated here as I don't have
a clue how to go about it.

Thanks in advance



Sub stantial()
Dim MyRange As Range, CopyRange As Range
Dim lastrow As Long
Set sht = Sheets("Sheet1")
lastrow = sht.Cells(Cells.Rows.Count, "G").End(xlUp).Row
Set MyRange = sht.Range("G1:G" & lastrow)
For Each c In MyRange
If c.Value = c.Offset(1).Value Then
If CopyRange Is Nothing Then
Set CopyRange = c.EntireRow
Else
Set CopyRange = Union(CopyRange, c.EntireRow)
End If
Else
Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = c.Value
CopyRange.Resize(CopyRange.Rows.Count + 1).Copy _
Destination:=Sheets(c.Value).Range("A1")
thislastrow = Sheets(c.Value).Cells(Cells.Rows.Count, "G").End(xlUp).Row + 1
Range("B" & thislastrow).Formula = "=sum(B1:B" & thislastrow - 1 & ")"
Range("C" & thislastrow).Formula = "=sum(C1:C" & thislastrow - 1 & ")"
Sheets(c.Value).Columns("B:C").NumberFormat = "0.00"
sht.Activate
Set CopyRange = Nothing
End If
Next
End Sub

==================================================

Any help with this is greatly appreciated.

Thanks in advance

Malcolm