أرجو المساعدة فى اصلاح هذا الكود

[Ali Mohamed Ali]

هذا الكود من اعمال الأستاذ زيزو العجوز

ولكن أريد معرفة العطل الواقع عليه لأنه لا يقوم بالترحيل

السلام عليكم ممكن المساعدة فى اتمام هذا البحث.rar

[سليم حاصبيا]

ممكن ان يكون هذا الماكرو هو الحل (تم تغيير اسماء الصفحات لحسن عمل الكود)

Option Explicit
Sub filter_for_ME()
    With Application
     .ScreenUpdating = False
     .Calculation = xlCalculationManual
    End With
    Dim lr_T_sh%
Dim S_sh As Worksheet: Set S_sh = Sheets("Source_sheet")
Dim T_sh As Worksheet: Set T_sh = Sheets("Target_sheet")
Dim My_Table As Range: Set My_Table = S_sh.Range("b2").CurrentRegion
T_sh.Range("b7").CurrentRegion.Borders.LineStyle = 0
T_sh.Range("b7").CurrentRegion.Interior.ColorIndex = 0
T_sh.Range("b7").CurrentRegion.ClearContents
T_sh.Range("t2").Formula = _
"=AND(B2<=Target_sheet!$C$3,B2>=Target_sheet!$C$2,E2=Target_sheet!$E$2,C2=Target_sheet!$D$2)"

My_Table.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=T_sh.Range("t1:t2"), _
CopyToRange:=T_sh.Range("b6:h6")
T_sh.Range("t2").ClearContents
 lr_T_sh = T_sh.Range("b7").CurrentRegion.Rows.Count + 5
    If lr_T_sh = 7 Then
          With Range("b6:H6")
              .Interior.ColorIndex = 0
              .ClearContents
              .Borders.LineStyle = 0
          End With
       MsgBox "No Data to Extract"
    Else
      T_sh.Range("b7:h" & lr_T_sh).Interior.ColorIndex = 6
    End If
    With Application
     .ScreenUpdating = True
     .Calculation = xlCalculationAutomatic
    End With
End Sub

الملف مرفق

Book3330 Salim.xlsm

[Ali Mohamed Ali]

شكرا جزيلا لك أخى سليم

بس أنا عايز صفحة البحث (المرحل إليها) تأخذ البيانات من ورقتين وتبدأ من تحت رأس الجدول

الأولى: من ورقة حركة الموردين

والثانية: من ورقة حركة النقدية

وبارك الله فيك

[Ali Mohamed Ali]

يا ريت لو ممكن الحل بالمعادلات