استدعاء بيانات باسم ملف متغير

[أبو إيمان]

السلام عليكم

حاولت توظيف الكود في الرابط التالي لكن لم ينجح الأمر معي 

المطلوب : عند الضغط على الزر يقوم بجلب البيانات من الملف المسمى بالرقم الموجود في الخلية K6 تقرير رصيد مع تاريخ شرط الاستدعاء الرقم مع كلمة تقرير رصيد بغض النظر عن التاريخ او ان يكون جزء من الاسم الرقم الموجود في الخلية K6

 البيانات التي يتم استدعاؤها تكون في الخلايا C6 E6 H6  

والخلايا من C9:O38

 

ملاحظة : الملفات التي يتم الاستدعاء منها محمية كاملا

مع ملاحظة ان الملفات المطلوب الاستدعاء منها في مجلد فرعي داخل نفس المجلد الذي به الملف الأساسي

 

 

 

 

 

الاستدعاء.rar

[أبو إيمان]

لقد حاولت 

وبفضل الله نجح الامر معي 

والشكر لجميع أعضاء المنتدى الشكر موصول للأخ Lionhear

Option Explicit

Sub Get_Data_From_Closed_Workbooks()
    Dim a, wb As Workbook, ws As Worksheet, sFile As String, sPath As String, lr As Long, m, x, y, z As Long
    Application.ScreenUpdating = False
        sPath = ThisWorkbook.Path & "\" & "تقارير" & "\"
        sFile = Dir(sPath & [k6] & "*" & ".xlsx")
        m = 9
        With Sheet12.Range("b8").CurrentRegion.Offset(1)
            .ClearContents: .Borders.Value = 0
        End With
        Do While sFile <> ""
            Set wb = Workbooks.Open(sPath & sFile, ReadOnly:=True)
            Set ws = wb.Sheets(1)
            With ws
                lr = .Cells(Rows.Count, "b").End(xlUp).Row
                a = .Range("b9:o" & lr).Value
                x = [c6]
                y = [e6]
                z = [h6]
                
                .Parent.Close False
            End With
            Sheet12.Range("b" & m).Resize(UBound(a, 1), UBound(a, 2)).Value = a
            m = m + UBound(a, 1)
            sFile = Dir()
        Loop
        With Sheet12.Range("b9:o" & m - 1)
            .Borders.Value = 1
        End With
        
        [c6] = x
        [e6] = y
        [h6] = z
        
End Sub