If cell equal to a value copy the row and the row above into

[bevg1971]

I need to a code vbs in excel that will find an specific value (TI), copy the row with the value and the row above, and paste into a new worksheet, then it needs to loop back and find the next instance and do the same task.

[pre]

5209845561ab	u	m	aaa-aaa	HU	CI	4/19/2013 21:24	4/19/2013 21:24
5209845561ab	u	m	aaa-aaa	HU	WC	4/22/2013 9:49	4/22/2013 9:50
5209845561ab	u	m	aaa-aaa	HU	TI	4/22/2013 10:28	4/22/2013 10:36
5209845561ab	u	m	aaa-aaa	HU	ST	4/22/2013 10:35	4/22/2013 10:35
5209845561ab	u	m	aaa-aaa	HU	HI	4/22/2013 22:08	4/22/2013 22:08
5209845561ab	u	m	aaa-aaa	HU	WC	4/22/2013 22:26	4/22/2013 22:34
5209845561ab	u	m	aaa-aaa	HU	TI	4/22/2013 22:58	4/22/2013 22:58
5209845561ab	u	m	aaa-aaa	HU	WC	4/23/2013 11:00	4/23/2013 11:01

[/pre]
Help please!! thanks!!

 

[Luke M]

I think this will do it. You'll need to change the sheet name and column reference maybe to match your exact setup, but this gets 99% of the way.

Sub CopyRows()

Dim CopyRows()
Dim destSheet As Worksheet
Dim searchWord As String

'Where are we pasting to?
Set destSheet = Worksheets("Sheet2")

'What are we looking for?
searchWord = "TI"

Application.ScreenUpdating = False
For i = 1 To lastRow(ActiveSheet)
    'search col F for text
    If Cells(i, "F").Value = searchWord Then
        Cells(i - 1, "F").Resize(2, 1).EntireRow.Copy _
        destSheet.Cells(lastRow(destSheet) + 1, "A")
    End If
Next i
Application.ScreenUpdating = True

End Sub

Function lastRow(s As Worksheet)
With s
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
End Function

PS. Cope could be improved in speed by using the .Find method. I'm feeling lazy however, and this way will hopefully be "good enough".

 

[bevg1971]

thank you for the reply... i was not notified about this response...

 

[Luke M]

Better late than never!