اذهب الي المحتوي
أوفيسنا

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


الردود الموصى بها

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

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

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

  • Like 3
رابط هذا التعليق
شارك

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

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

رابط هذا التعليق
شارك

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

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

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

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

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

  • Like 3
رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
×
×
  • اضف...

Important Information