لماذا لايعمل هذا الكود

[omar elhosseini]

الاخ alyfahem

 

 

Sub kh_Filter()
'
Dim LR As Long

10 With Sheet2
20    .Range(.Cells(9, 1), .Cells(Rows.Count, Columns.Count)).ClearContents
30 End With

40 With Sheet1
50    LR = .Cells(.Rows.Count, "AF").End(xlUp).Row
60    .Range("AD6:BH" & LR).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheet2.Range("A1:A2"), CopyToRange:=Sheet2.Range("C9"), Unique:=True
70 End With

80 Range("a3").Select
90 LR = Cells(Rows.Count, "AF").End(xlUp).Row
100 ActiveSheet.PageSetup.PrintArea = Range("b2:AB" & LR).Address
'
End Sub
 

السطر 20

يمسح منطقة اخراج البيانات قبل الفلتره من بداية السطر 9 حتي نهاية ترقيم الورقة

السطر 50 

لتحديد رقم اخر صف في قاعدة البيانات

السطر 60

كود للتصفية المتقدمة يحدد فيه مدي قاعدة البيانات ومنطقة مدي شروط التصفية وايضا مدي مخراجات ناتج التفية

السطر 90 

لتحديد رقم اخر صف في مدي المخراجات 

السطر 100

يقوم بطباعة مدي المخرجات

 

 

[ناصر سعيد]

العملاق عمر الحسيني

ربنا يحفظك

[ناصر سعيد]

Sub kh_Filter()
'''''
Dim LR As Long

With Sheet2


'يمسح منطقة اخراج البيانات قبل الفلتره من بداية السطر 9 حتي نهاية ترقيم الورقة
    .Range(.Cells(9, 1), .Cells(Rows.Count, Columns.Count)).ClearContents
End With

With Sheet1


'لتحديد رقم اخر صف في قاعدة البيانات
    LR = .Cells(.Rows.Count, "AF").End(xlUp).Row
    
    
  'كود للتصفية المتقدمة يحدد فيه مدي قاعدة البيانات ومنطقة مدي شروط التصفية وايضا مدي مخرجات ناتج التصفية
    .Range("AD6:BH" & LR).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheet2.Range("A1:A2"), CopyToRange:=Sheet2.Range("C9"), Unique:=True
End With

Range("a3").Select


'لتحديد رقم اخر صف في مدي المخرجات
LR = Cells(Rows.Count, "AF").End(xlUp).Row


'يقوم بتحديد مدي منطقة طباعه المخرجات
ActiveSheet.PageSetup.PrintArea = Range("b2:AB" & LR).Address
End Sub

وضعت شرح العملاق عمر الحسيني  مع الكود

كود فلتره 10.rar

[asdhamdey]

Sub mh()
'
' ماكرو2 ماكرو
' الماكرو مسجل ‎17/06/2016 بواسطة ‎11
'

'
    Range("A3:D47").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "f2:f3"), CopyToRange:=Range("H4:K4"), Unique:=False
    
    
   
End Sub

كود فلتره في نقس الصعحه

_الطلبة الضعاف.

[asdhamdey]

Sub Filter()
Dim LR As Long
With ورقة1
    LR = .Cells(.Rows.Count, "D").End(xlUp).Row
    .Range("c5:y5" & LR).AdvancedFilter xlFilterCopy, Range("aa1:aa2"), Range("c5:y5")
End With
Range("a1").Select
LR = Cells(Rows.Count, "D").End(xlUp).Row
ActiveSheet.PageSetup.PrintArea = Range("b2:y" & LR).Address
End Sub

اهداني احد اصدفائي فاردت ان نشاركوني

هذا الشرح للاستاذ  الفاضل عبد الباري البنا

 

شرح-كود-الفلتر.rar