Mike & Ryan

Thank you both so much for your help.

I actually appear to be a genius at work, although as usual, that will be
short lived.

The worksheet does and shows exactly what it is supposed to.

Once again, thank you bnoth very much.

Regards

Malcolm Davidson

"Mike H" wrote:

Hi,

This should take care of the summing and number formatting but because I
have included NO error checking you will get an error if you try and run the
code again because the shhet being added will already exist so you must
delete these sheets before re-running the code

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
--
Mike

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


"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