بحث بجزء من الكلمة

[محمد7788]

السلام عليكم

اساتذة المنتدى الكرام ارجو تعديل هذا الكود ليكون البحث بجزء من الكلمة 

ولكم جزيل الشكر

Function search_from_sheet1()
Dim rng1 As Range
Dim str_search As String
ThisWorkbook.Sheets("SHEET1").Activate
str_search = Range("I3")
ThisWorkbook.Sheets("SHEET2").Activate
Set rng1 = Sheets("SHEET2").Range("A:A").Find(str_search, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
rng1.Select
Dim row_number As Long
row_number = ActiveCell.Row
ThisWorkbook.Sheets("SHEET1").Activate
Range("I3") = Sheets("SHEET2").Range("A" & row_number)
Range("I4") = Sheets("SHEET2").Range("B" & row_number)
Range("I5") = Sheets("SHEET2").Range("E" & row_number)
Range("I7") = Sheets("SHEET2").Range("C" & row_number)
Range("I8") = Sheets("SHEET2").Range("g" & row_number)
Range("I9") = Sheets("SHEET2").Range("h" & row_number)
Range("I13") = Sheets("SHEET2").Range("f" & row_number)

Else
MsgBox str_search & ("برجاء ادخال الكود")
End If
End Function