What have I done wrong with this Macro???

Hi I have written the following Macro to copy specific data into separate worksheets dependenat on the cell value in columnA.
It works with copying cellValues of '9' into Sheet'9-10' but then it copies all data with cellValues of '9' or '10' into Sheet'10-11'. In thisa sheet i only want data with cellValue of '10' to be copied.

Please can you help!!!!!

Sub STEP3()
Dim rng As Range, cell As Range, sel As Range
Set rng = Intersect(Range("A:A"), ActiveSheet.UsedRange)
For Each cell In rng
If (cell.Value) = "9" Then
If sel Is Nothing Then
Set sel = cell
Else: Set sel = Union(sel, cell)
End If
End If
Next
On Error Resume Next
sel.EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("9-10").Select
Range("A3").Select
ActiveSheet.Paste

Sheets("Sheet2").Select
Set rng = Intersect(Range("A:A"), ActiveSheet.UsedRange)
For Each cell In rng
If (cell.Value) = "10" Then
If sel Is Nothing Then
Set sel = cell
Else: Set sel = Union(sel, cell)
End If
End If
Next
On Error Resume Next
sel.EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("10-11").Select
Range("A3").Select
ActiveSheet.Paste
End Sub

S,

Set sel to nothing before starting on sheet2.

Jim Cone
San Francisco, USA


"Shandy720"
<Shandy720.1tnmuc_1123855972.6749@excelforum-nospam.com>
wrote in message
news:Shandy720.1tnmuc_1123855972.6749@excelforum-nospam.com...Hi I have written the following Macro to copy specific data into
separate worksheets dependenat on the cell value in columnA.
It works with copying cellValues of '9' into Sheet'9-10' but then it
copies all data with cellValues of '9' or '10' into Sheet'10-11'. In
thisa sheet i only want data with cellValue of '10' to be copied.
Please can you help!!!!!

Sub STEP3()
Dim rng As Range, cell As Range, sel As Range
Set rng = Intersect(Range("A:A"), ActiveSheet.UsedRange)
For Each cell In rng
If (cell.Value) = "9" Then
If sel Is Nothing Then
Set sel = cell
Else: Set sel = Union(sel, cell)
End If
End If
Next
On Error Resume Next
sel.EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("9-10").Select
Range("A3").Select
ActiveSheet.Paste

Sheets("Sheet2").Select
Set rng = Intersect(Range("A:A"), ActiveSheet.UsedRange)
For Each cell In rng
If (cell.Value) = "10" Then
If sel Is Nothing Then
Set sel = cell
Else: Set sel = Union(sel, cell)
End If
End If
Next
On Error Resume Next
sel.EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("10-11").Select
Range("A3").Select
ActiveSheet.Paste
End Sub
--
Shandy720