الماكرو يعمل علي شيت واحد فقط؟

[الساحر NeT]

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

السادة الأساتذة الكرام 

برجاء المساعدة

قمت بعمل ماكرو يرحل من شيت لشيت اخر 

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

فكيف أفعله على جميع الشيتات بدون تغيير أسمائهم 

الكود 

 
 Sub ÊÑÍíá()

   Application.ScreenUpdating = False

    Sheets("all").Select

    Range("A1").Select

    Selection.End(xlDown).Select

    ActiveCell.Offset(1, 0).Range("A1").Select

    Sheets("1").Select

    Range("F5:G5").Select

    Range(Selection, Selection.End(xlDown)).Select

    Selection.Copy

    Sheets("all").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    ActiveCell.Offset(0, 1).Range("A1").Select

    Sheets("1").Select

    Range("C5").Select

    Range(Selection, Selection.End(xlDown)).Select

    Application.CutCopyMode = False

    Selection.Copy

    Sheets("all").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    ActiveCell.Offset(0, 1).Range("A1").Select

    Sheets("1").Select

    Range("M5:N5").Select

    Range(Selection, Selection.End(xlDown)).Select

    Application.CutCopyMode = False

    Selection.Copy

    Sheets("all").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    ActiveCell.Offset(0, 1).Range("A1").Select

    Sheets("1").Select

    Range("J5").Select

    Range(Selection, Selection.End(xlDown)).Select

    Application.CutCopyMode = False

    Selection.Copy

    Sheets("all").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    ActiveCell.Offset(0, 1).Range("A1").Select

    Sheets("1").Select

    Range("V5:X5").Select

    Range(Selection, Selection.End(xlDown)).Select

    Range("V5:X200").Select

    Application.CutCopyMode = False

    Selection.Copy

    Sheets("all").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Range("A20").Select

    Sheets("1").Select

    ActiveWindow.ScrollColumn = 6

    ActiveWindow.ScrollColumn = 2

    Range("F5:G5").Select

    Range(Selection, Selection.End(xlDown)).Select

    Application.CutCopyMode = False

    Selection.ClearContents

    Range("M5:N5").Select

    Range(Selection, Selection.End(xlDown)).Select

    Selection.ClearContents

    Range("M13:N13").Select

End Sub

 

 

[سليم حاصبيا]

لمعالجة الامر

ارفع نسخة مختصرة عن الملف (2 أو 3 شيتات) مع شرح لما هو مطلوب

[الساحر NeT]

شكرا استاذ سليم على المتابعه 

ربنا يبارك فيك يارب 

الماكرو.xlsm

[سليم حاصبيا]

صدقني لم افهم شيئاً من الماكرو الذي عندك

50 مرة Select دون جدوى

اشرح بالتفصيل

الصفحة  المصدر  ؟؟ الصفحة الهدف؟؟؟؟  ما هو النطاق الذي سيرحل ؟؟؟

[الساحر NeT]

استاذي الفاضل سليم 

اسف لعدم تمكني من التوضيح 

حضرتك عمل ماكرو لترحيل البيانات من ورقة 

اسمها 1

الي ورقة تحت مسمى All

عند الترحيل من الورقة المسماه ب 1

يتم الترحيل 

وعند الترحيل من صفحة أخرى تحت أي مسمى يدرج خطأ 

لان الماكرو مدرج في الكود ان البيانات ستنقل من 1 الي all

انا محتاج اني ارحل من اي ورقه

النطاق المطلوب ترحيله 

 من c5:c205, f5:f205, j5:j205, m5:m205, v5:x205

مطلوب ترحيلهم من اي ورقة لورقة all وادراجهم  بعد انتهاء اخر خلية ممتلئة بالعمود a

 

[سليم حاصبيا]

جرب هذا الملف (اذا كنت ما فهمته عليك صحيحاً)

My_Macro.xlsm

[الساحر NeT]

استاذ سليم انا اريد ترحيل البيانات من ورقة 1

وورقة 2..... الخ 

الي ورقة all 

الشيت به مثال وهايوضح اكتر ان شاء الله 

شكرا لحضرتك 

[سليم حاصبيا]

يا اخي المثال غير واضح تماماً 

جميع الجداول تحتوي على (الكود غير صحيح) و ليس هناك جدول كامل بينها

رجاء ارفق ملف فيه صفحتين أو ثلاثة لا أكثر (مع عدم دمج اي خليين داخل الجداول)

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

[الساحر NeT]

استاذ سليم 

شكرا لحضرتك الحمد لله تم حل المشكلة