إجمالي مرات مشاهدة الصفحة

الأربعاء، 27 أبريل 2016

التصفية التلقائية ونسخ الخلايا الظاهرة Autofilter & Copy Visible Cells

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

إليكم كود يقوم بعملية التصفية التلقائية Autofilter لنطاق ثم يقوم بنسخ الخلايا الظاهرة لعمود محدد ووضعها في قائمة حسب التصفية.

بفرض أن لديك بيانات في الأعمدة الثلاثة الأولى بهذا الشكل

والمطلوب توزيع الأسماء في العمود الثاني حسب اللجان في العمود الثالث ، لتكون النتائج بهذا الشكل
أي يتم إدراج كل اسم في اللجنة الخاصة به في العمود المناسب.

يعتمد الكود على عمل حلقة تكرارية للنطاق G2:J2 حيث يحتوي النطاق على أسماء اللجان المطلوب عمل تصفية للأسماء على أساسها ، وبعد عملية التصفية يتم نسخ الخلايا الظاهرة في العمود الثاني (عمود الأسماء) ولصقها في العمود المناسب حسب اسم اللجنة.

وأخيراً إليكم الكود ، ويوضع الكود في موديول عادي

Sub Autofilter_Copy_Visible_Cells()
    Dim Cel As Range

    Application.ScreenUpdating = False
        With ActiveSheet
            .Range("G3:J1000").ClearContents
    
            For Each Cel In .Range("G2:J2")
                .AutoFilterMode = False
                .Range("A1:C1").AutoFilter Field:=3, Criteria1:=Cel.Value
                .Range("B2:B" & .Cells(Rows.Count, 2).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy
    
                .Cells(3, Cel.Column).PasteSpecial xlPasteValues
            Next Cel
            
            .AutoFilterMode = False
            Application.Goto .Range("A1")
        End With
        
        Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

تحميل الملف من هنا

إعداد / ياسر خليل أبو البراء

هناك 3 تعليقات:

  1. السلام عليكم أخي ياسر
    زرت مدونتك وقد استفدت من محتوياتها كثيرا ، وواجب عليا أن أضع تعليقاً معبراً فيه عن جزيل شكري وأمتناني لك .
    دمت بخير

    ردحذف
  2. وعليكم السلام أخي العزيز علي مرجان
    بارك الله فيك ومشكور على مرورك العطر بالمدونة وإن شاء الله حين أتفرغ سأقدم المزيد

    ردحذف
  3. بارك الله فيك استاذ ياسر .. استفدت كثيرا.. رحم الله والديك!!!

    ردحذف