Compare and copy

[loop66]

Need help with project,i have two workbooks (over 5000 rows) need to compare same column B in both files if value is found then copy from book2 to book1 only columns C(to column N) and I(to column O) and put word OK in column M , if value is not found copy whole row in different order.

All details and samples are in attachment

Order if not found:
Column C(book2) to column N(book1)
Column D(book2) to column D(book1)
Column E(book2) to column E(book1)
Column I(book2) to column O(book1)
Column M(book2) to column C(book1)

24732

24733
24734

[mana]

Sub test()
Dim dic As Object
Dim tbl As Range
Dim v1, v2, w()
Dim k
Dim i As Long, j As Long, n As Long

Set dic = CreateObject("scripting.dictionary")

Set tbl = Workbooks("Book1.xlsx").Worksheets("List1").Cells(1).CurrentRegion
v1 = tbl.Value
v2 = Workbooks("Book2.xlsx").Worksheets("List1").Cells(1).CurrentRegion.Value

ReDim w(1 To Rows.Count, 1 To UBound(v1, 2))

For i = 1 To UBound(v1)
k = v1(i, 2)
dic(k) = i
For j = 1 To UBound(v1, 2)
w(dic(k), j) = v1(i, j)
Next
Next

For i = 2 To UBound(v2)
k = v2(i, 2)
If Not dic.exists(k) Then
dic(k) = dic.Count + 1
n = dic(k)
w(n, 1) = n - 1
w(n, 2) = k
w(n, 14) = v2(i, 3)
w(n, 4) = v2(i, 4)
w(n, 5) = v2(i, 5)
w(n, 15) = v2(i, 9)
w(n, 3) = v2(i, 13)
Else
n = dic(k)
w(n, 14) = v2(i, 3)
w(n, 15) = v2(i, 9)
w(n, 13) = "OK"
End If
Next

With tbl.Resize(dic.Count)
.Value = w
.Rows(2).Copy
.PasteSpecial xlPasteFormats
End With
Application.CutCopyMode = False

End Sub

[loop66]

Perfect,thnxxx