أرجو تصحيح الكود

[ايهاب الغريب]

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

ارجو مراجعة الكود في المرفق حيث انه لا يؤدي النتيجة المطلوبة

علما بان المطلوب هو

استيراد جميع البيانات من مصنف data الي مصنف مرتب شيت بيانات

 

Desktop.rar

[الـعيدروس]

السلام عليكم

الكود الذي في ملفك استبدله بالتالي بعد التعديل عليه

Sub Macro1()
Dim WB As Workbook, myRng As Range, Cell As Range
    Dim myRow As Long, lCol As Long
    Dim shMain As Worksheet
    Dim Sh As Worksheet
    Application.ScreenUpdating = False
    Application.EnableEvents = True
    Application.DisplayAlerts = False
    Set shMain = ThisWorkbook.ActiveSheet
    On Error Resume Next
    Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 91)).ClearContents
    Path = "d:\data.xlsx"
    Set WB = Workbooks.Open(Path)
    '=====================================================================
    On Error Resume Next
    Set Sh = WB.Sheets("Data")
        With Sh
        .Activate
         R = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row
        C = Range(Split(Sh.UsedRange.Address, "$")(3) & 1).Column
            Set myRng = WB.Sheets("Data").Range(.Cells(2, 1), .Cells(R, C))
            myRng.Copy
            shMain.Cells(2, 1).PasteSpecial xlPasteValues
        End With
    WB.Close True
    '=====================================================================
    On Error GoTo 0
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.EnableEvents = False
    Application.DisplayAlerts = True
    MsgBox "Task Completed"
    Application.Goto Reference:="Macro1"
    Range("D2").Select
End Sub

 

[ايهاب الغريب]

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

هو المطلوب