ترحيل من شيت لعدة شيتات اخرى

اسم الشيتات مكتوب فى خلية معينة

الكود
شرح الترحيل الغير منتظم لعدة شيتات
تحميل ملف العمل من هنا

ورقة العمل

خلية البحث

خلية اسم قاعدة البيانات

عمود البحث الموجود بقاعدة البيانات



البحث فى كل الشيتات على نفس المثال بالاعلى
Sub search_from_sheet()
Dim SheetName As String
Dim ws As Worksheet
Dim rng1 As Range
Dim str_search As String
For Each ws In Worksheets
SheetName = ws.Name
ThisWorkbook.Sheets("Sheet1").Activate
str_search = Range("E7")
ThisWorkbook.Sheets(SheetName).Activate
Set rng1 = Sheets(SheetName).Range("B:B").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("E5") = Sheets(SheetName).Range("A" & row_number)
Range("E7") = Sheets(SheetName).Range("B" & row_number)
Range("E9") = Sheets(SheetName).Range("D" & row_number)
Range("E11") = Sheets(SheetName).Range("E" & row_number)
Range("I5") = Sheets(SheetName).Range("F" & row_number)
Range("I7") = Sheets(SheetName).Range("G" & row_number)
Range("I9") = Sheets(SheetName).Range("I" & row_number)
Range("I11") = Sheets(SheetName).Range("J" & row_number)
Range("G13") = Sheets(SheetName).Range("K" & row_number)
Dim Result As String
Result = MsgBox("Current Sheet is : " & SheetName, vbOKCancel)
If Result = vbCancel Then
Exit Sub
End If
End If
Next
End Sub