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