What have I done wrong with this Macro???

  • Thread starter Thread starter Shandy720
  • Start date Start date
S

Shandy720

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

Please can you help!!!!! :confused:

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 Su
 
S,

Set sel to nothing before starting on sheet2.

Jim Cone
San Francisco, USA


"Shandy720"
<[email protected]>
wrote in message
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!!!!! :confused:

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
 
Back
Top