The attached code copies the all rows where the word Testing appears in
column F of sheet 1 and pastes the result in sheet 2

Sub CopyTestingRows()
Dim wksToSearch As Worksheet
Dim wksToPaste As Worksheet
Dim rngToSearch As Range
Dim rngToPaste As Range
Dim rngCurrent As Range
Dim rngFirst As Range
Dim rngFound As Range

Set wksToSearch = Sheets("sheet1")
Set wksToPaste = Sheets("Sheet2")
Set rngToSearch = wksToSearch.Columns(6)
Set rngToPaste = wksToPaste.Range("A2")

Set rngCurrent = rngToSearch.Find("Testing")
If rngCurrent Is Nothing Then
MsgBox "Testing was not found"
Else
Set rngFirst = rngCurrent
Set rngFound = rngCurrent
Do
Set rngFound = Union(rngCurrent, rngFound)
Set rngCurrent = rngToSearch.FindNext(rngCurrent)
Loop Until rngFirst.Address = rngCurrent.Address
rngFound.EntireRow.Copy rngToPaste
End If

End Sub

--
HTH...

Jim Thomlinson


"Junior728" wrote:

Hi Sir,

i am trying to find active cell value(Testing) from a column set of data but
when it comes to line:

Testing = Cells(i, 2).Value

Selection.Find(What:=Testing, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

it cannot continue to run the rest of the macro? why? Other than selection
find function, is there any other alternate function to obtain the same
results? Thanks.



Example:

Sub Reschedule()

Range("A1").Select
With Application
.Calculation = xlAutomatic
End With
With Application
.ReferenceStyle = xlA1
End With


Range("A1").Select
NumOfRows = Cells(Rows.Count, 1).End(xlUp).Row

Workbooks.Open Filename:="G:\Asia\Product\Operations\Part
Adjustments\VSJ Reschedule\vsj.xls"
Windows("vsj.xls").Activate

Windows("VSJ Reschedule1.xls").Activate
Sheets.Add

Windows("vsj.xls").Activate
Sheets("vsj").Select
Application.CutCopyMode = False
Sheets("vsj").Copy After:=Workbooks("VSJ Reschedule1.xls").Sheets(2)
ActiveWindow.SmallScroll Down:=-15


Windows("VSJ Reschedule1.xls").Activate
Sheets("Sheet1").Select


i = ActiveCell.Row

Testing = Cells(i, 2).Value

Range("B2").Select
For i = 2 To NumOfRows

If Not IsError(Testing) Then

ActiveCell.Select
Selection.Copy

Sheets("vsj").Select
Columns("F:F").Select

Selection.Find(What:=Testing, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

ActiveCell.EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste

End If

Next i

MsgBox ("Please run Macro2 after filling in all info")

End Sub