Sub Copy_To_Another_Sheet()
Dim FirstAddress As String
Dim Arr As Variant
Dim Rng As Range
Dim Rcount As Long
Dim I As Long
Application.ScreenUpdating = False
Arr = Array("x","y")
Rcount = 0
With Sheets("jd_soy").Range("g1:G3019")
For I = LBound(Arr) To UBound(Arr)
Set Rng = .Find(what:=Arr(I),_
After:=.Rows(.Rows.Count),_
LookIn:=xlFormulas,_
LookAt:=xlPart,_
SearchOrder:=xlByRows,_
SearchDirection:=xlNext,_
MatchCase:=False)
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
Rcount = Rcount + 1
Rng.EntireRow.Copy
Rng.EntireRow.Copy Sheets("test").Range("A" & Rcount).End(xlUp).Offset(1)
'Sheets("test").Range("A" & Rcount).Value = Rng.Cells
' Worksheets("test").Cells(Rng,1).Value = Rng.Row
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
End If
Next I
End With
Sheets("test").Select
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
End Sub