Highlighting Rows and Cut to another worksheet
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 |
Highlighting Rows and Cut to another worksheet
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 "DaveM" wrote: 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 |
Highlighting Rows and Cut to another worksheet
Thanks Mike
Works a treat All the best Dave "Mike H" wrote in message ... 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 "DaveM" wrote: 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 |
Highlighting Rows and Cut to another worksheet
Glad I could help
"DaveM" wrote: Thanks Mike Works a treat All the best Dave "Mike H" wrote in message ... 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 "DaveM" wrote: 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 |
All times are GMT +1. The time now is 05:12 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com