Highlighting Rows and Cut to another worksheet

D

DaveM

Hi

Excel 2002

sheet1 Column A this is formatted as Text

0001
0001
0002
0002
0002
0002
0002
0003
0003


I would like to hightlight the Rows of the first series of numbers, in this
case Rows A1,A2
Cut and paste them in sheet2, leaving......

0002
0002
0002
0002
0002
0003
0003


and when I use the code again it would move the 0002s

Thanks in advance

Dave
 
M

Mike H

Hi,

Right click sheet1 tab, view code and paste this in. Note that this appends
to the data on sheet2

Sub copyit()
Dim myrange, MyRange1 As Range
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Set myrange = Range("A2:A" & lastrow)
firstvalue = Range("A1").Value
Set MyRange1 = Rows(1)
For Each c In myrange
If c.Value = firstvalue Then
Set MyRange1 = Union(MyRange1, c.EntireRow)
End If
Next
If Not MyRange1 Is Nothing Then
MyRange1.Copy
lastrow = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Sheet2").Range("A" & lastrow + 1).PasteSpecial
'Sheets("Sheet2").Range("A1").PasteSpecial
MyRange1.Delete
End If
End Sub


Mike
 
D

DaveM

Thanks Mike

Works a treat

All the best

Dave


Mike H said:
Hi,

Right click sheet1 tab, view code and paste this in. Note that this
appends
to the data on sheet2

Sub copyit()
Dim myrange, MyRange1 As Range
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Set myrange = Range("A2:A" & lastrow)
firstvalue = Range("A1").Value
Set MyRange1 = Rows(1)
For Each c In myrange
If c.Value = firstvalue Then
Set MyRange1 = Union(MyRange1, c.EntireRow)
End If
Next
If Not MyRange1 Is Nothing Then
MyRange1.Copy
lastrow = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Sheet2").Range("A" & lastrow + 1).PasteSpecial
'Sheets("Sheet2").Range("A1").PasteSpecial
MyRange1.Delete
End If
End Sub


Mike
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top