Try this code and see if it does what you want. Let me know how it goes.
Sub Find_And_Copy()
Dim FindRange As Range
Dim myStr As String
Dim firstFind As String
Dim c As Range
Dim countCopies As Integer
Dim pasteAddress As String
myStr = InputBox("Enter word to be searched")
If myStr = "" Then Exit Sub
'NOTE: Adjust the range here to suit your
'search range.
Set FindRange = Worksheets(1).Range("d1:d16")
With FindRange
Set c = .Find(What:=myStr, _
LookIn:=xlFormulas, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not c Is Nothing Then
countCopies = 0
firstFind = c.Address
Do
'NOTE: when pasting an entire row
'it must start from column A otherwise
'an error occurs because it will not
'fit across the worksheet
c.EntireRow.Copy Destination:= _
Range("Sheet5!A65536 ").End(xlUp).Offset(1, 0)
countCopies = countCopies + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And _
c.Address <> firstFind
End If
End With
'Select copied rows
countCopies = countCopies - 1
Sheets("Sheet5").Select
Range("Sheet5!A65536 ").End(xlUp).Select
Range(ActiveCell, ActiveCell.Offset(-countCopies, 0)) _
.EntireRow.Select
End Sub
Regards,
OssieMac
"1clncc" wrote:
>
> The below would search in the current worksheet rows containing myStr
> then pasting those rows into another sheet ("5".
>
> ************************************************************
>
> myStr = InputBox("Enter word to be searched")
> If myStr = "" Then Exit Sub
>
> Find_Range(myStr, Range("Eng_Name"), LookIn:=xlValues, LookAt:=
> xlPart, MatchCase:=True).EntireRow.Copy Range("Sheet5!
> D65536").End(xlUp).Offset(1, 0).EntireRow
>
> *****************************************************
>
> 1) how to set counter in the find/paste operations to find out the
> number of lines being pasted into sheet(5)?
>
> 2) then select those pasted lines.
>
>
|
Similar Threads
