Sub CopyRange()

t = timr

    Application.DisplayAlerts = False

    Application.ScreenUpdating = False

    Application.DisplayClipboardWindow = False

    Dim desWS As Worksheet, srcWB As Workbook, s As String

    Set desWS = ThisWorkbook.Sheets("ورقة1")

    Dim LastRow As Long

'   Const strPath As String = "E:\ClosedFiles\افضل حل\do\"

    Dim strPath As String

    strPath = ThisWorkbook.Path & "\do\"

    ChDir strPath

    strExtension = Dir(strPath & "*.xls*")

    Do While strExtension <> ""

        s = FileLastModified(strPath & strExtension)

        Set srcWB = Workbooks.Open(strPath & strExtension)

        With srcWB.Sheets("ورقة1")

            LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

            .Range("A2:I" & LastRow).Copy

            With desWS

                .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

            End With

        End With

        srcWB.Close False

        strExtension = Dir

    Loop

    Application.ScreenUpdating = True

    Application.DisplayAlerts = True

'MsgBox Round(Timer - t, 2)

End Sub

Function FileLastModified(StrFileName As String)

    Dim fs As Object, f As Object, s As String

    Set fs = CreateObject("Scripting.FileSystemObject")

    Set f = fs.GetFile(StrFileName)

    s = UCase(StrFileName) & vbCrLf

    Set fs = Nothing: Set f = Nothing

End Function