التعديل علي كود جلب بيانات من ملفات مغلقة

Sub ImportData()

Dim wbBook1 As Workbook, wbBook2 As Workbook

Dim Path As String

Dim Arr As Variant, i As Long, LR As Long, LS As Long

Application.ScreenUpdating = False

Set wbBook1 = ThisWorkbook

wbBook1.Sheets("1").Range("D3:BZ25").ClearContents

Path = wbBook1.Path & ""

Arr = Array("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "i")

For i = LBound(Arr) To UBound(Arr)

Set wbBook2 = Workbooks.Open(Path & Arr(i) & ".xls")

Dim wsSheet1 As Worksheet

Dim wsSheet2 As Worksheet

Set wsSheet1 = wbBook1.Worksheets("1")

Set wsSheet2 = wbBook2.Worksheets("Feuil1")

If LS < 3 Then

LS = 3

Else

LS = wsSheet1.Cells(3, Columns.Count).End(xlToLeft).Column

End If

On Error Resume Next

wsSheet1.Cells(3, LS + 1).Resize(23, 5).Value = wsSheet2.Range("C8:G30").Value

wbBook2.Close True

Next

Application.ScreenUpdating = True

End Sub