تعديل على كود ترحيل من مصنف مفتوح لمصنف مغلق بدون فتحه

[أبو قاسم]

صبحكم الله بالخير ياوجوة الخير  

 

تحية اجلال واحترام للطيبين 

 

اليوم عندي كود نرحيل موجود في ملف (اكسل1) يرحل الى ملف (اكسل2) لاكن المشكلة انة يرحل ليس بشكل منتظم مرة يرحل الى تحت ومرة الى فوق 

 

ومحتاج يرحل ملف اكسل 1 الى ملف اكسل 2 ويكون ملف اكسل 2 مغلق مش ضروري اقوم بفتح الملف 

 

حاول اعدل لم استطيع  عمل شي 

 

الله يجزية الف خير من حاول مساعدتي وشكرا للجميع 

ملف ترحيل.rar

[ياسر خليل أبو البراء]

أخي الصالح صالح أحمد

يرجى إرفاق الملف مرة أخرى وبه بعض البيانات لمعرفة النطاق المراد ترحيله وإلى أين تريد الترحيل ..

ارفق بعض النتائج المتوقعة .. حتى تجد المساعدة من الأخوة

[أبو قاسم]

اشكر مرورك استاذ ياسر افتح المرفق هو جاهز وبة كود ترحيل يكون الترحيل من اكسل1 الى اكسل2  من الخلية a2 الى q  في الطر الثالث 

[ياسر خليل أبو البراء]

أخي الفاضل صالح

ما بالكم إخواني إذا طلبت منكم طلب بسيط تهربتم مني ! والله إني لأعجب ..

أخبرتك أخي أن تضع بعض البيانات في الملف المرفق لتجربة الكود وسألتك عن الخلايا التي سيتم الترحيل إليها فلم تبالي بسؤالي ..

التوضيح يوفر الوقت والجهد ويجعل الموضوع لا يطول حتى يتمكن الأعضاء من مساعدة الجميع

أرجو تفهم الأمر بارك الله فيكم

 

أخي إليك الكود التالي على قدر ما فهمت ....

Sub TransferDataToClosedWB()
    Dim WB As Workbook
    Dim LR_A As Long, LR_B As Long
    Dim Answer As Long
    LR_A = IIf(Cells(Rows.Count, 1).End(xlUp).Row = 1, 1, Cells(Rows.Count, 1).End(xlUp).Row)
    
    Application.ScreenUpdating = False
        
        If Application.WorksheetFunction.CountA(Range("A1:A" & LR_A)) < 1 Then MsgBox "لا يوجد بيانات لترحيلها", vbInformation: Exit Sub
        
        ThisWorkbook.Sheets("Sheet1").Range("A3:Q" & LR_A).Copy
        Set WB = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & "اكسل2.xlsx")
        With WB.Sheets("Sheet1")
            LR_B = IIf(Cells(Rows.Count, 1).End(xlUp).Row = 1, 1, Cells(Rows.Count, 1).End(xlUp).Row + 1)
            .Range("A" & LR_B).PasteSpecial xlPasteValues
            .Range("A" & .Cells(.Rows.Count, 1).End(xlUp).Row + 1).Select
        End With
        
        Answer = MsgBox("تم الترحيل بفضل الله" & Chr(10) & "هل تريد مسح البيانات التي تم ترحيلها؟", vbQuestion + vbYesNo)
        If Answer = vbYes Then
            ThisWorkbook.Sheets("Sheet1").Range("A3:Q" & LR_A).ClearContents
        Else: End If
        
        WB.Close SaveChanges:=True
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

أرجو أن يكون الحل صحيحاً وألا يكون فيه تعقيب لأنه لو به تعقيب فهذا بسبب قصور التوضيح

ولك جزيل الشكر على اهتمامك بأمر التوضيح الذي طلبته منك

Transfer Data To Closed Workbook YasserKhalil.rar

[أبو قاسم]

 الاستاذ ياسر مشكور ربنا يحفظك صراحة مبدع شي افضل من اللي كنت اتوقع لك ارفع القبعة احترام واجلال

[ياسر خليل أبو البراء]

أخي الكريم صالح أحمد

الحمد لله أن تم المطلوب على خير وكله بفضل الله وحده

حل المشكلة يستغرق مني وقت ليس بالقليل .. لا تنسى أن تضغط على كلمة "أعجبني هذا" كنوع من رد الجميل ، ولن يستغرق الأمرك منك الوقت الطويل .. فقط ثانية واحدة يا جميل (القافية حكمت على رأي أخونا مختار)