Finding Values and Copying Corresponding values

[Clubber]

Hi all,

I am a newbie to VBA, and any help/advice is extremely welcome.

I have a peice of coding which searches for certain values in a sheet, copies these values, and pastes them on the next sheet, yet with two problems: -

1. It only copies the values, and not the data in the neighbouring cell, as i require both parts of the data

2. The values i will search for will range from 1 to maybe a thousand, in incraments of 10 (eg 1, 10, 20....), and it seems very time consuming to type all these variants in.

Below is the code: -

Sub Copy_To_Another_Sheet_1()
    Dim FirstAddress As String
    Dim MyArr As Variant
    Dim Rng As Range
    Dim Rcount As Long
    Dim I As Long
    Dim NewSh As Worksheet

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Fill in the search Value
    MyArr = Array("10", "20")

    'You can also use more values in the Array
    'myArr = Array("10", "20", "30")

    'Add new worksheet to your workbook to copy to
    'You can also use a existing sheet like this
    'Set NewSh = Worksheets.Add
    Set NewSh = Sheets("Sheet2")

    With Sheets("Sheet1").Range("A:A")

        Rcount = 0

        For I = LBound(MyArr) To UBound(MyArr)

            'If you use LookIn:=xlValues it will also work with a
            'formula cell that evaluates to "@"
            'Note : I use xlPart in this example and not xlWhole
            Set Rng = .Find(What:=MyArr(I), _
                            After:=.Cells(.Cells.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.Copy NewSh.Range("A" & Rcount)

                    ' Use this if you only want to copy the value
                    ' NewSh.Range("A" & Rcount).Value = Rng.Value

                    Set Rng = .FindNext(Rng)
                Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
            End If
        Next I
    End With

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Thanks in advance for any help.