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

[hicham2610]

السلام عليكم

كيف أعدل على macro6  في تاملف المرفق بحيث ينشئ أربعة أوراق باسم 100،101،102 و103

بحيث ينسخ الجدول 0 في 100

والجدول1  في101

والجدول  2في102

والجدول 3 في103

كما في المثال إلى غاية السطر 51 ليحتمل عدد التلاميذ في حدود 50 تلميذا

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

1.xlsm

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

1- في الورقة الاساسية قم بتسمية الجداول كما يلي

     (RG_1 (TABLE1)           RG_2 (TABLE2  
     (RG_3 (TABLE3)           RG_4 (TABLE4 

2-قم بتسمية الشيت الاساسية  "Main"   (أفضل عدم تسمية الاوراق باللغة العربية لصعوبة نسخ الكود ولصقه حيث تظهر علامات و أحرف  غير مفهومة)

 3-نفذ هذا الماكرو

Option Explicit
Sub Copy_ranges()
'=======================================
Rem RG_1 (TABLE1):RG_2 (TABLE2)
Rem RG_3 (TABLE3):RG_4 (TABLE4)
'======================================
Dim k As Byte
Dim i As Byte
k = 1
For i = 1 To 4
Sheets(k).Range("A1").CurrentRegion.Clear
Sheets("Main").Range("RG_" & i).Copy Sheets(k).Range("A1")
k = k + 1
Next

End Sub

الملف مرفق

COPY TABLES.xlsm

[hicham2610]

جربته، جيد

================================

جزاك الله خيرا وأحسن إليك

===============================

[hicham2610]

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

مثلا ب:F0/F1/F2/F3

أو

100/101/102/103

لأن الاشتغال يكون عليه أكثر من مرة وستنضاف إليه برمجات أخرى وفي كل مرة تتغير الأسماء إن تركت لإكسيل حرية التسمية

================================

جزاكم الله خيرا وأحسن إليكم

===============================

•  

تم تعديل يوليو 4, 2019 بواسطه hicham2610

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

جرب هذا الماكرو

Option Explicit
Sub Rename_Sheets()
Dim sh As Worksheet
'=========================
'choose here the name
Dim My_name$: My_name = "Salim"
'===========================
Dim t As Byte
For Each sh In Sheets
 If sh.Name <> "Sheet1" Then
  sh.Name = My_name & "" & t
  t = t + 1
End If
Next
End Sub

 

[hicham2610]

الأخ سليم حاصبيا

جزاك الله خيرا وأتابك الجنة وشكرا على متابعتك

دمجت كود إنشاء الأوراق مع ماسبق (نسخ الجداول)

فلم ينجح معي