كود ترحيل بيانات الى عدة شيتات بشرط

[محمد عبد الناصر]

اريد ترحيل بيانات السطر بالكامل على حسب اسم الطبيب المعالج 
فمثلا الطبيب المعالج اسمه "احمد" ينقل بيانات الطبيب احمد الى شيت الدكتور احمد
وكذلك الدكتور حاتم ينقل جميع بيانات الدكتور حاتم الى شيت الدكتور حاتم
الملف المرفق موضح المطلوب

جعله الله في موازين حسناتكم 

fik.xlsm

[حسين مامون]

جرب هذا الكود ولكن يجب ان تكون مسميات الشيتات كما في العمود (i)

Sub Envoier_donner()
Dim sh As Worksheet
Dim ws As Worksheet
Set ws = Sheets("التقرير")
Dim lr1, lr2, x, x2
Application.ScreenUpdating = False
 For Each sh In ThisWorkbook.Worksheets
   lr1 = ws.Cells(Rows.Count, 2).End(3).Row
     For x = 11 To lr1
        If ws.Cells(x, "i").Text = sh.Name Then
        lr2 = sh.Cells(Rows.Count, 2).End(3).Row + 1
        sh.Range("b" & lr2).Resize(1, 12).Value = ws.Cells(x, 2).Resize(1, 12).Value
        End If
     Next x
 Next sh
Application.ScreenUpdating = True
End Sub

 

fik.xlsm

[حسين مامون]

جرب المرفق

fik.xlsm

[محمد عبد الناصر]

نعم هذا هو المطلوب تماما بوركت وبارك الله في علمك