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

[ياسر أحمد الشيخ]

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

عندى 31 ملف فى فولدر اريد نسخ شيت واحد من كل ملف إلى ملف جديد ويتم ترقيم هذه الشيتات فى الملف الجديد من 1 إلى رقم آخر ملف

أريد كود لعمل ذلك

لاحظ :اسم الشيت Safety 

واسم أول الملف Daily Plant Report 1-1-2015

إلى آخر ملف باسم Daily Plant Report 31-1-2015

وشكرا

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

ارفق ملفك أخي الحبيب .. أنت أصبحت من ذوي الخبرة بالمنتدى

تقبل تحياتي يا برنس

[ياسر أحمد الشيخ]

انا محتار ارفق أى ملف

[ياسر أحمد الشيخ]

 اسف على التأخير

لقد ارفقت ملفين

source file:Daily plant report 1-1-2015

قمت بحذف كل الشيتات ما عدا الشيت المطلوب نسخه

destination file : Assemble Safety 2015

اريد نسخ شيت safety كله بتنسيقاته وقيمه من daily plant إلى ملف assemble safety 2015

ارجو الاهتمام

 

 

 

Assemble Safety 2015.zip

Daily plant report 1-1-2015.zip

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

حتى تتضح الصورة أكثر ..

أنت لديك أكثر من مصنف باسم Daily plant report وبه ورقة عمل .. تسمى Safety كما وضحت أم تسمى Alternative Fuel؟

هل الورقة بنفس الاسم في كل المصنفات الموجودة إليك ؟؟

نقطة أخرى : المصنف الأم الذي سيحوي الكود الذي سيقوم بعملية التجميع لهذه الشيتات ، يحتوي على أوراق عمل بالفعل كما وضحت في المرفق من 1 إلى 31 أم أن هذا للتوضيح فقط ؟؟

اعذرني لكثرة الأسئلة عن توضيح الأمر لكن حتى يتم العمل بشكل جيد بدون أي لبس في فهم المطلوب

[ياسر أحمد الشيخ]

شكرا جزيلا أخى ياسر خليل على ردك واهتمامك

بالنسبة لاستفساراتك تفضل أخى:

1- اسم الشيت Safety 

وهذا الاسم متكرر فى جميع الملفات

2- اريد أخى أن يتم نسخ الشيت Safety من daily plant report11-1-2015 ويتم لصقه فى الملف assemble Safety 2015  فى الشيت رقم واحد

و

أن يتم نسخ الشيت Safety من daily plant report 2-1-2015 ويتم لصقه فى الملف assemble Safety 2015  فى الشيت رقم اثنين

وهكذا

مرة أخرى شكرا جزيلا أخى ياسر خليل

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

أخي الكريم ياسر الشيخ

إليك مرفق فيه طلبك ... بس على ملفات تجربة من عندي ..

ضع ملفاتك المسماة Daily Plant Report  في مجلد باسم Files وضع المصنف الرئيسي خارج المجلد كما هو موضح بالمرفق ..

ادخل على المصنف الرئيسي وقم بتغيير الكود ليناسب طلبك .. قم بتغيير كلمة Sheet1 إلى Safety في الكود

Sub CopySpecificSheetFromDifferentWorkbooks()
    Dim FolderPath As String, FileName As String
    Dim WorkBk As Workbook
    Dim SourceSheet As Worksheet
    Dim I As Long
    
    I = 1
    FolderPath = ThisWorkbook.Path & "\Files\"
    FileName = Dir(FolderPath & "*.xl*")
    
    Application.ScreenUpdating = False
        Do While FileName <> ""
            Set WorkBk = Workbooks.Open(FolderPath & FileName)
            Set SourceSheet = WorkBk.Worksheets("Sheet1")
            SourceSheet.Copy After:=Workbooks(ThisWorkbook.Name).Sheets(I)
            ActiveSheet.Name = I
            I = I + 1
            WorkBk.Close savechanges:=False
            FileName = Dir()
        Loop
        Range("A1").Select
    Application.ScreenUpdating = True
End Sub

Copy Specific Sheet From Different Workbooks.rar

[ياسر أحمد الشيخ]

شكرا أخى ياسر خليل على ردك

حل رائع ولكن هناك مشكلة صغيرة أريد أن يتم تسمية الشيت على حسب الملف المأخوذ منه مثال:

1- الملف باسم Daily plant report 1-2-2015  يصبح الشيت باسم 1

2 الملف باسم Daily plant report 2-2-2015  يصبح الشيت باسم 2

3-الملف باسم Daily plant report 3-2-2015  يصبح الشيت باسم 3

4- الملف باسم Daily plant report 4-2-2015  يصبح الشيت باسم 4

5- الملف باسم Daily plant report 5-2-2015  يصبح الشيت باسم 5

وهكذا

حيث أن كل ملف خاص بيوم معين فى الشهر

وشكرا أخى مرة أخرى

تم تعديل مارس 3, 2015 بواسطه ياسر أحمد الشيخ

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

جرب الكود

Sub CopySpecificSheetFromDifferentWorkbooks()
    Dim FolderPath As String, FileName As String
    Dim WorkBk As Workbook
    Dim SourceSheet As Worksheet
    Dim I As Long
    
    I = 1
    FolderPath = ThisWorkbook.Path & "\Files\"
    FileName = Dir(FolderPath & "*.xl*")
    
    Application.ScreenUpdating = False
        Do While FileName <> ""
            Set WorkBk = Workbooks.Open(FolderPath & FileName)
            Set SourceSheet = WorkBk.Worksheets("Sheet1")
            SourceSheet.Copy After:=Workbooks(ThisWorkbook.Name).Sheets(I)
            ActiveSheet.Name = Mid(WorkBk.Name, 20, 1)
            I = I + 1
            WorkBk.Close savechanges:=False
            FileName = Dir()
        Loop
        Range("A1").Select
    Application.ScreenUpdating = True
End Sub

[ياسر أحمد الشيخ]

شكرا أخى على سرعة الرد

ولكن هناك مشكلة فى هذا السطر ActiveSheet.Name = Mid(WorkBk.Name, 20, 1)

وذلك أثناء فتح الملف Daily Plant Report 10-2-2015

وشكرا أخى مرة أخرى

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

حلها بسيط إن شاء الله

بس معلش تتعب في أول 9 ملفات وتخليهم 01 ، 02 وهكذا لحد 09 وبعد كدا 10 ، 11 وهكذا

جرب المرفق التالي فيه نماذج لمصنفات بنفس الاسم ... وغيرت اسم ورقة العمل إلى Safety حتى لا تقوم بأي تعديل آخر

 

Copy Specific Sheet From Different Workbooks V2.rar

[ياسر أحمد الشيخ]

حل رائع أخى بس هأتعبك معايا شوية ياريت تستحملنى

لى طلبين آخرين ليكتمل العمل:

1- أريد عمل Progress Bar يوضح مدى تقدم هذا الكود لأنه يأخذ وقت طويل

2- هل يمكن القيام بعملية الترحيل بدون فتح الملفات Daily PLant لأن الكود يأخذ وقت طويل

وشكرا جزيلا

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

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

وسؤالي لك كم من الوقت يستغرق الكود؟ وما هو عدد المصنفات التي يتم فتحها ..؟؟

أنا جربت الكود ولا يستغرق سوى بضع ثواني

[ياسر أحمد الشيخ]

نعم أخى يوجد حيث تم استخدامها فى ملف مجمع البيانات Data Collector للأستاذ محمد طاهر

انظر الرابط : http://www.officena.net/ib/index.php?app=downloads&showfile=109

يستغرق الكود أكثر من 5 دقائاق ، لأن الملفات Daily plant report ثقيلة جدا حيث تحتوى على شيتات كثيرة وتنسيقات كثيرة جدا ومعادلات أكثر 

>>>>>هل يمكن عمل pogress bar يوضح رقم الملف الذى يعمل عليه حتى أعرف متى ينتهى الكود من عمله

مثلا: الملف رقم 1 من اجمالى 31 ملف

ثم الملف رقم 2 من اجمالى 31 ملف

وهكذا

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

أخي الفاضل صراحة لا أجيد عمل Progress Bar ...

ننتظر أحد الأخوة دوي الخبرة في هذه المسألة

[ياسر أحمد الشيخ]

شكرا أخى على اهتمامك

للرفع