Hi Berlan,
Thanks for the tip. I've some doubts on your code though. In the last part, why do you do the Intersect stuff? I adapted the code to my files and became something like the code bellow where I want to paste the information in a another workbook begining in the Cell A15. When I run the macro it gives me a warning box saying "Run Time Error '9': Subscript out of range"
Sub test()
Dim r As Range, rngOut As Range
Dim sAdr As String, sSite As String
sSite = InputBox("Please enter site name:")
With Workbooks("original_excel.xls").Sheets("original_sheet").Columns("D")
'loop and find all matching
Set r = .Find(sSite, , xlValues, xlWhole) 'change xlPart to xlWhole for exact match
If Not r Is Nothing Then
sAdr = r.Address
Do
If rngOut Is Nothing Then Set rngOut = r Else Set rngOut = Union(r, rngOut)
Set r = .FindNext(r)
Loop While r.Address <> sAdr
End If
If Not rngOut Is Nothing Then
Intersect(.Parent.Range("A:D"), rngOut.EntireRow).Copy
Workbooks("destination_excel.xls").Sheets("Sheet1").CELL ("A15")
End If
End With
End Sub
I had tried also replace the Itersect part for something more basic like the code bellow but it also failed giving me the same message
rngOut.EntireRow.Copy
Workbooks("Data.xls").Sheets("Sheet1").CELL("A15").PasteSpecial
Can you help me again?
Thanks
Bookmarks