إضافة ورقة جديدة ونسخ محتوى الورقة السابقه وتغيير إسمها تلقائيا

[الجموعي]

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

هل من طريقه لإضافة ورقة جديدة ونسخ محتوى الورقة السابقه وتغيير إسمها تلقائيا مع الحفاظ على التنسيقات السابقه

مثلا:

الورقه السابقه 2010 اريد ظهور الصفحة الجديدة 2011 والصفحة التي تليها 2012 وهكذا.....

ملاحظه: تتم هذه الطريقه عند الضغط على إضافه ورقه جديده

 

المصنف2.rar

تم تعديل فبراير 27, 2014 بواسطه الجموعي

[رجب جاويش]

السلام عليكم

تفضل أخى

Sub ragab()
Application.ScreenUpdating = False
x = Val(ActiveSheet.Name)
For i = 1 To Sheets.Count
If Val(Sheets(i).Name) > x Then x = Val(Sheets(i).Name)
Next
Sh_Name = x + 1
ActiveSheet.Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Sh_Name
Sheets(1).Select
Application.ScreenUpdating = True
End Sub

المصنف3.rar

[الجموعي]

 

السلام عليكم

تفضل أخى

Sub ragab()
Application.ScreenUpdating = False
x = Val(ActiveSheet.Name)
For i = 1 To Sheets.Count
If Val(Sheets(i).Name) > x Then x = Val(Sheets(i).Name)
Next
Sh_Name = x + 1
ActiveSheet.Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Sh_Name
Sheets(1).Select
Application.ScreenUpdating = True
End Sub

ممتاز جدا استاذي الفاضل

بارك الله فيك

الذي كنت أقصده ليس عن طريق الزر وإنما عن طريق إضافه ورقة جديده

[الجموعي]

وفي سؤال ثاني لو الصفحة الأولى بها بيانات أريد عند نسخها محو البيانات بإستثناء بيانات الصف العلوي

المساحة الصفراء تصبح فارغه من البيانات

 

تم تعديل فبراير 27, 2014 بواسطه الجموعي

[وليد فتحي]

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

ممكن تراجع الموضوع ده أخي الفاضل

 

http://www.officena.net/ib/index.php?showtopic=51999

[رجب جاويش]

تفضل أخى

Private Sub Workbook_NewSheet(ByVal Sh As Object)
Application.ScreenUpdating = False
x = Val(Sheets(1).Name)
For i = 1 To Sheets.Count
If Val(Sheets(i).Name) > x Then x = Val(Sheets(i).Name)
Next
Sh_Name = x + 1
ActiveSheet.Move After:=Sheets(Sheets.Count)
ActiveSheet.Name = Sh_Name
Sheets(1).Cells.Copy
ActiveSheet.Range("A1").PasteSpecial xlPasteFormats
ActiveSheet.Range("A1:G1").Value = Sheets(1).Range("A1:G1").Value
Application.CutCopyMode = False
Sheets(1).Select
Application.ScreenUpdating = True
End Sub

المصنف 4.rar

[إبراهيم ابوليله]

اخى واستاذنا رجب

اكوادك دائما تجبرنا على متابعة

مشاركاتك

دائما ما تبدع حينما تكتب

ويعجز اللسان على ان يقول فيك ما تستحقه

ولا نجد من الكلمات غير

بارك الله فيك

وزادك من علمه

[الجموعي]

 

تفضل أخى

Private Sub Workbook_NewSheet(ByVal Sh As Object)
Application.ScreenUpdating = False
x = Val(Sheets(1).Name)
For i = 1 To Sheets.Count
If Val(Sheets(i).Name) > x Then x = Val(Sheets(i).Name)
Next
Sh_Name = x + 1
ActiveSheet.Move After:=Sheets(Sheets.Count)
ActiveSheet.Name = Sh_Name
Sheets(1).Cells.Copy
ActiveSheet.Range("A1").PasteSpecial xlPasteFormats
ActiveSheet.Range("A1:G1").Value = Sheets(1).Range("A1:G1").Value
Application.CutCopyMode = False
Sheets(1).Select
Application.ScreenUpdating = True
End Sub

 

 

ماشاء الله عليك أستاذي

بارك الله فيك

مزالت نقطه واحده

والمتمثله في عند إضافة ورقه جديده تبقى الورقة محدده إلا إذا ضغطت بالماوس على الصفحة ينزع التحديد

[الجموعي]

اخى واستاذنا رجب

اكوادك دائما تجبرنا على متابعة

مشاركاتك

دائما ما تبدع حينما تكتب

ويعجز اللسان على ان يقول فيك ما تستحقه

ولا نجد من الكلمات غير

بارك الله فيك

وزادك من علمه

أستاذي إبراهيم بارك الله فيك على حضورك المشجع للأساتذه

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

محتاجك في موضوع مساعده في فورم

[رجب جاويش]

تفضل أخى

 

المصنف 4.rar

[رجب جاويش]

أخى الفاضل / الجموعي

شكرا جزيلا أخى الفاضل على هذه الكلمات الطيبة

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

[رجب جاويش]

أخى الحبيب / ابراهيم

شكرا جزيلا أخى الفاضل على هذه الكلمات الطيبة

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

[الجموعي]

تفضل أخى

يعجز اللسان عن شكرك أستاذي رجب جاويش

بارك الله فيك وكثر الله من امثالك.

[رجب جاويش]

أخى الفاضل / الجموعي

لا شكر على واجب أخى الفاضل

بارك الله فيك

[محمد يوسف محمد1]

أخى الحبيب الغالى / رجب

ايه الحلاوة دى والتمكن دة زادكم الله من علمه

[رجب جاويش]

أستاذنا الفاضل / محمد يوسف

شرفنى جدا مرورك العطر وكلماتك الطيبة

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

[حمادة باشا]

الأستاذ الفاضل/رجب جاويش

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

كود رائع - جزاكم الله كل خير

تقبل تحياتي

[رجب جاويش]

أخى الفاضل / حمادة باشا

شكرا جزيلا أخى الفاضل على هذه الكلمات الطيبة

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