from the OP's original question

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

--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"Ryan H" wrote:

Is your staff data in Col. G sorted? I believe Mikes code works beautifully
if it is sorted. I basically tweaked Mikes code. Hope this helps! If so,
let me know, click "YES" below.

Sub stantial()

Dim MyRange As Range
Dim CopyRange As Range
Dim lastrow As Long

Set sht = Sheets("Sheet1") ' Change to suit
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")
sht.Activate
Set CopyRange = Nothing

' add sum formula at end of Col.B & Col. C
With wks
lastrow = .Cells(Rows.Count, "G").End(xlUp).Row
.Cells(lastrow + 1, "B").Formula = "=SUM(B2:B" & lastrow & ")"
.Cells(lastrow + 1, "C").Formula = "=SUM(C2:C" & lastrow & ")"

' number format
.Range("B2:B" & lastrow + 1).NumberFormat = "0.00"
.Range("C2:C" & lastrow + 1).NumberFormat = "0.00"
End With

End If
Next c

End Sub

--
Cheers,
Ryan


"malycom" wrote:

Mike

First impressions look amazing.

Done a couple of random checks and so far all the data is correct.

Now, not meaning to be greedy as what you have done so far is fantastic, but
is there a way of adding something that will auto sum colum B and auto sum
column C and also make columns B & C so they format as number to two decimal
points.

I appreciate if that's a question to far but you appear to be a Ninja with
Excel.

Once again, thanks for what you have done.

Regards

Malcolm Davidson
"Mike H" wrote:

Hi,

Not extensively tested but try this

Sub stantial()
Dim MyRange As Range, CopyRange As Range
Dim lastrow As Long
Set sht = Sheets("Sheet1")' Change to suit
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")
sht.Activate
Set CopyRange = Nothing
End If
Next
End Sub


--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"malycom" wrote:

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

Malcolm Davzidson