برجاء المساعدة في كود فتح شيت جديد

[شعبان فليفل]

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Application.DisplayAlerts = False
If Target.Column <> 3 Or Target.Count > 1 Then Exit Sub

lr = Sheets("Accounts").Range("c" & Rows.Count).End(xlUp).Rows.Value

Sheets("Sample").Copy after:=Sheets(Sheets.Count)
On Error Resume Next
  x = Len(Sheets(lr).Name)
        If IsEmpty(x) Then
                        ActiveSheet.Name = lr
                        ActiveSheet.Range("b2") = lr
        Else
                Answer = MsgBox("This sheet is allredy exit" & Chr(10) & "do you wnat to replace it?", vbYesNo)
                             If Answer = 6 Then
                                      Sheets(lr).Delete
                                      ActiveSheet.Name = lr
                                      ActiveSheet.Range("b2") = lr
                              Else
                                     ActiveSheet.Delete
                              End If
        End If
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub

هذا الكود أحيانا يعمل وأخري لا يعمل

ما المشكلة 

المطلوب تحويله إلي زر 

تم تعديل مارس 23, 2017 بواسطه شعبان فليفل

[khalid_star2005]

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

[شعبان فليفل]

الشيت يعمل كالآتي 

C في العمود Accounts أي إضافة في صفحة 

Sample يفتح صفحة جديدة بنفس الاسم يتم نسخها من صفحة 
B2 ويكتب اسم العميل في الصفحة الجديدة في الخليفة 

B في العمود Projects كما يتم كتابة اسم العميل في صفحة 

المشكلة 

 لبعض العملاء لا يعمل الكود Cut أو عمل  Accounts عند مسح عميل من صفحة

قد تكون المشكلة كثرة الصفحات حيث أنها تزيد عن 70 

وقد تكون زيادة الأكواد ففي كل صفحة من الـ 70 بها أكود حماية وكتابة التاريخ 

وقد تكون كثرة الدوال فكل صفحة من الـ 70 بها دوال كثيرة 

Test1.rar

 

 

Test1.rar