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