Sheet sabitleme

[emrehan26]

İyi akşamlar.
Elimde forumdan temin ettiğim bir dosya var. A sütununa değer girilince girdiğimiz değer ile aynı isimde sheet açıyor.A sütunundan değeri sildiğimizde sheet de siliniyor. Şablon ve anasayfa adında 2 sheet sabit. Ben arıca Yedek isminde bir sheet açıp onuda sabitlemek istiyorum. Aşağıda ki kodlara nasıl bir ilave yapmam gerekir. Şimdiden teşekkürler.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("a1:a65536")) Is Nothing Then Exit Sub
sayfa_adı = Target.Text
If Target.Count <> 1 Then Exit Sub
For i = 2 To Cells(65536, 1).End(xlUp).Row
Sheets("şablon").Visible = True
If Target.Address <> Cells(i, 1).Address Then
If Target = "" Then GoTo son
If Cells(i, 1) = Target Then
MsgBox Target.Text & vbCrLf & "Bu İsim Daha Önceden Girilmiş!!!", vbCritical, "UYARI!!!"
Target = Empty
Target.Select
GoTo son
End If
End If
Next

Sheets("şablon").Copy After:=Sheets(Sheets.Count)

ActiveSheet.Name = sayfa_adı
son:
Sheets("şablon").Visible = False
Dim mySht As Variant

Application.DisplayAlerts = False

For Each mySht In ActiveWorkbook.Sheets
If mySht.Visible = True Then
mySht.Activate
If Application.Evaluate("=MAX(LEN(f1:f1))") = 0 Then
mySht.Delete
End If
End If
Next
ThisWorkbook.Worksheets("ana sayfa").Activate
Application.DisplayAlerts = True
End Sub

 

[ZorBey_]

Merhaba
İyi Çalışmalar
Ekli Dosyayı Denermisiniz

 

[emrehan26]

İlginiz için teşekkürler. Gönderdiğiniz dosyayı da arşivledim. Fakat şuan için mevcut dosyada çözüm bulmam gerekiyor. Tekrardan teşekkür ederim.