كود فتح ورقه جديدة بالاسم المكتوب في خلية محدده (طلب تعديل )

[محمد عبد الناصر]

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

هذا الكود يقوم بتفح ورقة جديدة على حسب المكتوب في AM14 

المطلوب ان يقوم بقفل و حماية هذه الورقة الذي يقوم بفتحها لعدم العبث او تخريب البيانات بها

Sub CopySheet()
    Dim strName As String, Sh As Worksheet
    strName = Trim(Sheet4.Range("am14").Value)
    
    For Each Sh In Worksheets
        If Sh.Name = strName Then Exit Sub
    Next Sh
    
    Sheet4.Copy after:=Sheets(Sheets.Count)
    Sheets("sheet1 (2)").Name = strName
    With Sheets(strName)
        .Shapes("Button 1").Delete
        With .Range("b10:am1009")
        .Value = .Value
       End With
    End With
     Sheets("الشاشة الرئيسية").Select
    Range("A1").Select
End Sub

 

[محي الدين ابو البشر]

هذا الكود يقوم بتفح ورقة جديدة على حسب المكتوب في AM14 

المطلوب ان يقوم بقفل و حماية هذه الورقة الذي يقوم بفتحها لعدم العبث او تخريب البيانات بها

Sub CopySheet()
    Dim strName As String, Sh As Worksheet
    strName = Trim(Sheet4.Range("am14").Value)
    
    For Each Sh In Worksheets
        If Sh.Name = strName Then Exit Sub
    Next Sh
    Sheet4.Copy after:=Sheets(Sheets.Count)
     ActiveSheet.Name = strName
    ActiveSheet.Protect "password" ' ضع كلمة السر بدل password
    With Sheets(strName)
        .Shapes("Button 1").Delete
        With .Range("b10:am1009")
        .Value = .Value
       End With
    End With
     Sheets("الشاشة الرئيسية").Select
    Range("A1").Select
End Sub

 

تم تعديل مارس 5, 2023 بواسطه محي الدين ابو البشر

[محمد عبد الناصر]

7 دقائق مضت, محي الدين ابو البشر said:

هذا الكود يقوم بتفح ورقة جديدة على حسب المكتوب في AM14 

المطلوب ان يقوم بقفل و حماية هذه الورقة الذي يقوم بفتحها لعدم العبث او تخريب البيانات بها

Sub CopySheet()
    Dim strName As String, Sh As Worksheet
    strName = Trim(Sheet4.Range("am14").Value)
    
    For Each Sh In Worksheets
        If Sh.Name = strName Then Exit Sub
    Next Sh
    Sheet4.Copy after:=Sheets(Sheets.Count)
     ActiveSheet.Name = strName
    ActiveSheet.Protect "password" ' ضع كلمة السر بدل password
    With Sheets(strName)
        .Shapes("Button 1").Delete
        With .Range("b10:am1009")
        .Value = .Value
       End With
    End With
     Sheets("الشاشة الرئيسية").Select
    Range("A1").Select
End Sub

 

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

[محي الدين ابو البشر]

بارك الله