تعديل كود لدمج مجموعة اوامر في امر واحد

[khalid_star2005]

لدي كود يعمل على نسخ بيانات من عدة ملفات خارجية الى ملف واحد

الكود في المرفق

كل ما اريده هو دمج مجموعة الاوامر في امر واحد

ملاحظة على ان يكون الكود ينقل البيانات ولو زاد عدد الملفات الخارجية دون الحاجة لتعديل الكود

11.rar

[khalid_star2005]

ارجو المساعده

 

تم تعديل يناير 27, 2017 بواسطه khalid_star2005

[khalid_star2005]

لماذا لا يوجد اي رد هل الطلب غير معقول او غير مهم؟؟؟؟؟؟؟؟؟؟؟؟؟

[khalid_star2005]

 

تم تعديل يناير 27, 2017 بواسطه khalid_star2005

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

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

الملف المرفق لا يتم تحميله ، يرجى إعادة رفع الملف مرة أخرى

والأفضل إرفاق بعض النتائج المتوقعة

[khalid_star2005]

اخي الكريم تم اعادة رفع الكود

لدي ملفات خارجية عددها 26 ملف

وتم تسمية الملفات بالاحرف الابجدية الانكليزية

من

A

ال

Z

الملاحظات

اولاً عند عدم وجود احد الملفات الخارجية سوف يظهر خطأ

ثانياً عند اضافة ملف خارجي اخر سوف لن يقوم بنسخ بياناته

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

 

11.rar

تم تعديل يناير 27, 2017 بواسطه khalid_star2005

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

الملف المرفوع عبارة عن ملف نصي بداخله كود

الأفضل إرفاق الملفات أو نماذج منها وشرح المطلوب بلغة الإكسيل كأن تقول المصنف الرئيسي اسمه كذا والمطلوب في ورقة العمل كذا أن توضع البيانات الواردة من ورقة كذا في المصنف كذا ... حاول تحدد شكل المخرجات وضع بعض النتائج المتوقعة

[khalid_star2005]

اخي العزيز ياسر

تم تقليص عدد المدارس وعدد الصفوف لتقليص الزخم في البرنامج

الملف داتا هو الملف الاساسي

الملفات المسماة بلاحرف هي الثانوية

اولا عليك نقل فولدر داتا الي البارتشن دي

قبل تشغيل مايكرو النسخ عليك الضغط على زر فتح ملفات المدارس لكي يعمل مايكرو النسخ

دي ملفات خارجية عددها 4 ملف

وتم تسمية الملفات بالاحرف الابجدية الانكليزية

من

A

ال

D

الملاحظات

اولاً عند عدم وجود احد الملفات الخارجية سوف يظهر خطأ

ثانياً عند اضافة ملف خارجي اخر سوف لن يقوم بنسخ بياناته

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

data.rar

ملاحظة نسخة الاوفيس 2016

32 bit

[khalid_star2005]

@ياسر خليل أبو البراء 

[khalid_star2005]

اخي العزيز

 @ياسر خليل أبو البراء

ممكن جواب

 

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

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

أعتذر للتأخير في الرد ، فأنت تعلم أن لكل منا ما يشغله

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

Sub CopyFromClosedWorbooks()
    Dim wb              As Workbook
    Dim folderPath      As String
    Dim fileName        As String
    Dim counter         As Double
    Dim i               As Integer
    Dim lr              As Long

    folderPath = "D:\Data\"
    fileName = Dir(folderPath & "*.xlsx")

    Application.ScreenUpdating = False
    Application.Calculation = xlManual
        Do While fileName <> ""
            If fileName <> ThisWorkbook.Name Then
                Set wb = Workbooks.Open(folderPath & fileName)
    
                With ThisWorkbook.Sheets("احصائية المدارس")
                    lr = .Cells(Rows.Count, 6).End(xlUp).Row + 1
                    .Range("B" & lr).Resize(1, 16).Value = wb.Worksheets(1).Range("B4:Q4").Value
                End With
    
                wb.Close SaveChanges:=False
            End If
            fileName = Dir()
        Loop
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True

    MsgBox "Done ...", 64
End Sub

 

[khalid_star2005]

اخي العزيز

انا اسف ازعجتك

الكود يقوم بفتح الملفات ولكن بدون ادراج البيانات بدون غلق ايضاَ

 

 

تم تعديل يناير 29, 2017 بواسطه khalid_star2005

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

لقد جربت الكود ويقوم بفتح الملفات بدون تدخل منك ثم ينسخ اليبانات المطلوبة ويضعها في الملف الرئيسي Data .. لو أمكنك تصور فيديو أو تضع صور لما يحدث معك بالضبط لكي نستطيع تقديم المساعدة ...

الملفات في المجلد المسمى Data في البارتشن D

[khalid_star2005]

اخي الغالي انا اعتذر منك

كان الخلل بسببي عمل الكود بشكل رائع

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

واشكرك من كل قلبي

تحياتي الك يا غالي

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

الحمد لله أن تم المطلوب على خير والحمد لله الذي بنعمته تتم الصالحات