Find Value with help of Macro

[Abhijeet]

Hi

I have Macro to find Value in Range but i want if that value match then copy given range & paste in next sheet that data.please tell me how to do this

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("Dr")

    'You can also use more values in the Array
    'myArr = Array("@", "www")

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

    With Sheets("Sheet1").Range("A1:A1000")

        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

 

[Luke M]

Looks like the macro already does that, in the Do loop it copies Rng to NewSh. What's the problem?

 

[Abhijeet]

Hi Luke M

That copy only column A data which match i want that entire row or given range data paste in new sheet

 

[Luke M]

Then just change this

 Rng.Copy NewSh.Range("A" & Rcount)

to this

 Rng.EntireRow.Copy NewSh.Range("A" & Rcount)

 

[Abhijeet]

Thanks its work perfect