نسخ شيت وتغيير اسمه

[eziyad]

السلام عليكم

الاخوان الاعزاء في هذا المنتدى الرائع

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

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

ملاحظة // تم استخدام الكود التالي في عملية نسخ Sheet1

Worksheets("Sheet1").Copy After:=Worksheets("Sheet3")

مع جزيل الشكر

جديد.rar

[عمرو رحيل]

غير عنوان الموضوع بما يعبر عن مضمون موضوعك حتى يمكن الاجابة على سؤالك

[أبو أنس حاجب]

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

أخي الفاضل حفظك الله

جرب هذا الكود

Application.ScreenUpdating = False

Sheets("sheet1").Select

Sheets("sheet1").Copy after:=Sheets("sheet1")

Sheets("sheet1 (2)").Select

Sheets("sheet1 (2)").Name = Sheets("sheet3").[f2]

Sheets("sheet3").Select

[f2].Select

أبو أنس

[عبدالله باقشير]

السلام عليكم

انصح باستخدام الدالة kh_Test_MyChr

عند اعادة تسمية شيت

لمعرفة اخطاء التسمية ان وجدت

المرفق 2003و 2007

Sub kh_CopySheet()

Dim MyName As String

MyName = [F2]

If kh_Test_MyChr(MyName) = True Then Exit Sub

Sheets("sheet1").Copy After:=Sheets(Sheets.Count)

Cells.Worksheet.Name = MyName

End Sub

'===============================================

Function kh_Test_MyChr(KhString As Variant) As Boolean

Dim MySh As Worksheet

Dim MyChArray, MyChr

Dim S As Integer, R As Integer

S = Len(Trim(KhString))

If S > 31 Or S = 0 Then

MsgBox "حروف الاسم قد تكون اصغر من 1 او اكبر من 31", 524288 + 1048576 + 16, "اسم مرفوض"

kh_Test_MyChr = True

Exit Function

End If

'------------------------------------

MyChArray = Array("/", "*", ":", "؟", "?", "[", "]")

For Each MyChr In MyChArray

If InStr(1, KhString, MyChr, 1) <> 0 Then

MsgBox "حروف الاسم تحتوي على الحرف " & Chr(10) & Chr(10) & Chr(9) & MyChr & Chr(10) & Chr(10) & "وهو من الاحرف الممنوعة " & "/ * : ؟ [ ]", 524288 + 1048576 + 16, "حرف ممنوع"

kh_Test_MyChr = True

Exit Function

End If

Next

'------------------------------------

For Each MySh In ActiveWorkbook.Sheets

If UCase(Trim(MySh.Name)) = UCase(Trim(KhString)) Then

MsgBox "الاسم مكرر ", 524288 + 1048576 + 16, "اسم مكرر"

kh_Test_MyChr = True

Exit Function

End If

Next

End Function

جديد.rar

[جمال عبد السميع]

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