نسخ بيانات من مصنف مغلق لمصنف آخر

Sub Test()

    'Q8 >> Cell With Workbook Name | Q12 >> First Cell To Put Results

    '----------------------------------------------------------------

    GetDataFromClosedWorkbook "Q8", "Q12"

    GetDataFromClosedWorkbook "u8", "u12"

    GetDataFromClosedWorkbook "y8", "y12"

End Sub

 

Sub GetDataFromClosedWorkbook(sFileCell As String, sStartCell As String)

    Dim wb              As Workbook

    Dim ws              As Worksheet

    Dim a               As Variant

    Dim strFileName     As String

    Dim sFilter         As String



    Set ws = ThisWorkbook.Worksheets("UIR")

    strFileName = ThisWorkbook.Path & "" & ws.Range(sFileCell).Value & ".xlsx"

    sFilter = "$F$11:$F$141"



    Application.ScreenUpdating = False

        With ws.Range(sStartCell)

            .Resize(.CurrentRegion.Rows.Count, 4).ClearContents

        End With

        ws.Range(sFilter).AutoFilter Field:=1



        If Len(Dir(strFileName)) > 0 Then

            Set wb = Workbooks.Open(Filename:=strFileName)

            With wb.Worksheets(1)

                .Range(sFilter).AutoFilter Field:=1

                a = .Range(sStartCell).Resize(.Range(sStartCell).CurrentRegion.Rows.Count, 4).Value

                ws.Range(sStartCell).Resize(UBound(a, 1), UBound(a, 2)).Value = a

                .Parent.Close False

            End With



            ws.Range(sFilter).AutoFilter Field:=1, Criteria1:="1"

            Application.Goto ws.Range("S2")

        Else

            MsgBox strFileName & " Can't Be Found!", vbExclamation, "File Not Found"

        End If

    Application.ScreenUpdating = True

End Sub