Modify code from array to string

[femma]

Hi!
Is there a way to modify this code so that the MyArr-variable would be the value in the first cell with text in column A of sheet1? Also could it go through all the cells in columnA of sheet2 with text in them and do the same search and copypaste-thing as it does now for the MyArr-value?

Here is the code

Sub testi2()

    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


    MyArr = Array("TECON020")

    Set NewSh = Sheets("Sheet1")


    With Sheets("Sheet2").Range("B1:B500")

        Rcount = 0

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

            Set Rng = .find(What:=MyArr(I), _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                FirstAddress = Rng.Address
                Do
                    Rcount = Rcount + 1

                    Range(Rng, Rng.Offset(-1, 0)).Copy
                    With NewSh.Range("C" & Rcount)
        .PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
        End With


                    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

My goal is to get all the values found to be actually in Listbox1 in Userform3, but for now the copying to column C is enough

Any help is much appreciated