جلب بيانات حسب المواليد

[Ahmed Emannan]

السلام عليكم

نامل المساعدة من الاخوة الاعزاء

لدي ملف اريد ان استدعي بيانات من الورقة 1 الي الورقة 2

مثلا اريد مواليد 1980فقط او مواليد 1970 وهكذا

نامل المساعدة

تحياتي

Book1.rar

[عبدالله باقشير]

السلام عليكم

Sub KH_START()
Dim MyRng As Range
Dim O As Integer, XX As Integer, R As Integer, RR As Integer
Set MyRng = Range("A2:A20")
Range("D2:E1000").ClearContents
O = 2
With æÑÞÉ1
    XX = .Range("A" & .Rows.Count).End(xlUp).Row
    For R = 2 To XX
        For RR = 1 To Application.CountA(MyRng)
            If .Cells(R, 2) = MyRng.Cells(RR, 1) Then
                Cells(O, 4) = .Cells(R, 1)
                Cells(O, 5) = .Cells(R, 2)
                O = O + 1
            End If
        Next RR
    Next R
End With
End Sub

تفضل المرفق

Book1.rar

[Ahmed Emannan]

مشكور اخي خبور وبارك الله فيك علي مجهودك الرائع وردك

لكن هناك مشكلة في الكود المرفق

تحياتي

[سمير نجار]

السلام عليكم ورحمة الله وبركاته

استاذي الكريم خبور خير

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

هل تتكرم علينا وتشرح هذا الكود وخاصة الجزء set و with

ولك كل الشكر

السلام عليكم

[عبدالله باقشير]

السلام عليكم ورحمة الله وبركاته

الاخ/SAM ------------حفظه الله

هل تتكرم علينا وتشرح هذا الكود وخاصة الجزء set و with

============================================

تعليمة WITH

========

تسمح هذه التعليمة بالتاثيرعل الغرض عدة مرات باستدعاء اسمه مرة واحدة

مثلا هذا الكود

Y = ActiveSheet.UsedRange.Rows.Count
ActiveSheet.PageSetup.PrintArea = "$B$3:$T$" & Y

استخدمنا الغرض ActiveSheet مرتين عند استخدام WITH

With ActiveSheet
        Y = .UsedRange.Rows.Count
        .PageSetup.PrintArea = "$B$3:$T$" & Y
   End With

=========================================== اذا اردنا اسناد غرض الى متحول Objest نستخدم set مثلا:

Set MyRng = Range("n12:dg60")

=========================================== الاخ/dvb------------حفظه الله باستخدام التصفية

Sub kh_Filter()
Dim MyRng As Range
Dim XX As Integer, ZZ As Integer
With ورقة1
    XX = .Range("A" & .Rows.Count).End(xlUp).Row
    Set MyRng = .Range("A1:B" & XX)
End With
With ورقة2
    ZZ = Application.CountA(.Range("A1:A20"))
    MyRng.AdvancedFilter Action:=xlFilterCopy _
    , CriteriaRange:=.Range("A1:A" & ZZ) _
    , CopyToRange:=.Range("D1:E1"), Unique:=True
End With
End Sub

تفضل المرفق

Book1.rar

تم تعديل يونيو 15, 2009 بواسطه خبور خير

[Ahmed Emannan]

مشكور اخي خبور وبارك الله فيك

تحياتي علي الشرح الرائع

دمت عماراً للمنتدى الغالي

[سمير نجار]

السلام عليكم ورحمة الله وبركاته

استاذي الكريم خبور خير

بارك الله فيك وفي ميزان حسناتك ان شاء الله تعالى

عمل اكثر من رائع

هل يوجد شرح مفصل عن عمل هذه الادوات في الاكواد مثل On Error GoTo او set او with او غيرها

ولك كل الشكر

تلميذك سمير نجار

السلام عليكم