بحث عن رقم الموظف بملفات اخرى

[أبوبسمله]

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

اخوانى الكرام تقبلوا منى فائق التحيه والاحترام والتقدير

الموضوع اريد البحث عن رقم الموظف بملفات اخرى مرفقه بداخل فولدر مع الملف الاساسى المراد تجميع البيانات به

الملف المراد تجميع البيانات به اسمه البيان ويوجد معه فولد اسمه NewِAll بداخله ملفان 6-2015 و 7-2015

قمت بتظبيط المعادله ولكن اريد مراجعتها هل هيا صحيحه ام لا حتى اعتمد عليها فان كان بها خطأ فارجو منكم ظبطها وان كانت صحيحه ومظبوطه ماشى وان كان هناك حل افضل من هذا فجزاكم الله عنى خير الجزاء

والسلام ختام وانتظر ردودكم اللتى تشرح صدرى وفقكم الله لما فيه الخير والفلاح

البيان النهائى$.rar

[ياسر خليل أبو البراء]

أخي العزيز أحمد الفلاحجي

لا تعلم مدى المعاناة التي عانيتها مع ملفاتك خصوصاً الملف المسمى "البيان" .. لا أعلم عندما قمت بعمل معاينة وجدت حوالي 1180 ورقة .. حاولت التخلص من البيانات الزائدة وعند حذف الأعمدة الزائدة يهنج الأوفيس ويغلق الملف وحاولت مراراً وتكراراً إلى أن تخلصت من هذه المشكلة وأبقيت على الأعمدة المطلوبة فقط في النطاق A1:Q

عموماً جرب الكود التالي ..عله يفي بالغرض (رغم أن معادلاتك تعمل بشكل جيد كما لاحظت إلا أنني أفضل استخدام الأكواد نظراً لما تسببه المعادلات من ثقل في الملف خصوصاً مع البيانات الكثيرة)

Sub ImportDataFromClosedWBUsingVLOOKUP()
    Dim WBK As Workbook
    Dim Rng As Range
    Dim LastRow As Long
    Dim I As Long
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
        With ThisWorkbook.Sheets("Sheet1")
            Set WBK = Workbooks.Open(ThisWorkbook.Path & "\NewAll\7-2015.xlsx")
            Set Rng = WBK.Sheets("Sheet1").Range("G2:J" & Cells(Rows.Count, "G").End(xlUp).Row)
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            
            .Range("F3").Resize(LastRow - 1).Formula = "=IFERROR(VLOOKUP(A3," & Rng.Address(, , , True) & ",4,False),"""")"
            .Range("P3").Resize(LastRow - 1).Formula = "=IFERROR(VLOOKUP(A3," & Rng.Address(, , , True) & ",3,False),"""")"
            
            WBK.Close SaveChanges:=False
            
            '================================================================================================================
            
            Set WBK = Workbooks.Open(ThisWorkbook.Path & "\NewAll\6-2015.xlsx")
            Set Rng = WBK.Sheets("Sheet1").Range("G2:S" & Cells(Rows.Count, "G").End(xlUp).Row)
            
            .Range("E3").Resize(LastRow - 1).Formula = "=IFERROR(VLOOKUP(A3," & Rng.Address(, , , True) & ",10,False),"""")"
            .Range("G3").Resize(LastRow - 1).Formula = "=IFERROR(VLOOKUP(A3," & Rng.Address(, , , True) & ",12,False),"""")"
            .Range("H3").Resize(LastRow - 1).Formula = "=IFERROR(VLOOKUP(A3," & Rng.Address(, , , True) & ",3,False),"""")"
            .Range("I3").Resize(LastRow - 1).Formula = "=IFERROR(VLOOKUP(A3," & Rng.Address(, , , True) & ",13,False),"""")"
            
            For I = 1 To 6
                .Cells(3, I + 9).Resize(LastRow - 1).Formula = "=IFERROR(VLOOKUP($A3," & Rng.Address(, , , True) & "," & I + 3 & ",False),"""")"
            Next I
            
            .Range("Q3").Resize(LastRow - 1).Formula = "=IFERROR(VLOOKUP(A3," & Rng.Address(, , , True) & ",11,False),"""")"
            .Range("E3:Q" & LastRow).Value = .Range("E3:Q" & LastRow).Value
            
            WBK.Close SaveChanges:=False
        End With
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

وإليك الملف المرفق فيه تطبيق للكود وتم ضبط الملف الرئيسي "البيان" وجعلته بعنوان جديد (يمكنك تغيير اسمه لاسم "البيان" مرة أخرى ..لن يؤثر على عمل الكود)

تقبل تحياتي

Import Data From Closed Workbooks Using VLOOKUP Flahgy.rar

[أبوبسمله]

قبل ان اجرب الملف

احب ان ابدى اعجابى باصرارك الدائم وماتزعلش المره الجايه هجبلك الملفات بسيطه وسهله علشان متتعبش حبيبى ههههههههههههههههههه

احببت مراجعت المعادله للتاكد فقط واكيد الكود من ايدك احلى يا ابو البراء

جزاك الله كل خير

سوف اقوم بفتح الملف والاطلاع وارجعلك يااغالى

 

 

تسلم ايدك ياغالى على هذه الروائع

جزاك الله كل خير وبارك الله لك فى وقتك وعملك

لا اجد ما اقوله بجد الحمد لله الذى بفضله تتم الصالحات

[ياسر خليل أبو البراء]

وجزيت خيراً بمثل ما دعوت لي أخي الحبيب أحمد

بارك الله فيك على دعائك الطيب ..

لك الحرية في استخدام المعادلات أو الأكواد ..فأنت أدرى بملفك وبعملك مني ، فقط أحببت أن أثري موضوعك وأقدم حل بالأكواد يوفر الوقت والجهد الذي تسببه المعادلات في كثير من الأحيان

الحمد لله الذي بنعمته تتم الصالحات

تقبل تحياتي