help on find and copy
Sub MySearch()
Dim c As Range
Dim rng As Range
Dim c1 As Range
Dim rng1 As Range
Dim iEnd As Integer
Dim iRow As Integer
iEnd = Sheets("Sheet1").Range("A1").End(xlDown).Row
Set rng1 = Sheets("Sheet1").Range("A2:A" & iEnd)
iEnd = Sheets("Sheet2").Range("A1").End(xlDown).Row
Set rng = Sheets("Sheet2").Range("A2:A" & iEnd)
iRow = 1
For Each c In rng
For Each c1 In rng1
If c = c1 Then
iRow = iRow + 1
Sheets("search results").Cells(iRow, 1) = c1
Sheets("search results").Cells(iRow, 2) = c1.Offset(0, 1)
End If
Next c1
Next c
End Sub
Hth,
Merjet
|