Counts of Find/Copy Lines

[1clncc]

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.

 

[Guest]

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]

Checked, it looks good. Thanks.