Korumalı Sayfada Tablo genişleme sorunu

[ByBaklan]

Merhabalar,

Ekteki dokümanda da göreceğiniz gibi, Bir tablom var. Bu tabloya veri girdikçe satır ekleyerek genişlemesi gerekiyor.
Bir taraftan da kullanıcıların tabloyu ve sayfa yapısını kurcalamalarını istemediğim için kilitlemek istiyorum.
Kilitlediğim zaman da tablo genişlemiyor.

Nasıl bir çözüm bulabiliriz? VBA ile mi, Makro ile mi ya da tablo dışında başka bir çözüm mü olması gerekiyor?

Yardımlarınız için şimdiden teşekkür ederim.

 

[YUSUF44]

Aşağıdaki kodları ilgili sayfanın kod bölümüne yapıştırırsanız E sütununda sondan bir önceki satırda değişiklik yaptığınızda korumayı kaldırıp satır ekler, diğer hücre ve sütunlarda değişiklik olduğunda koruma yapar:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, [E:E]) Is Nothing Then
    If Target.Row = Cells(Rows.Count, "E").End(3).Row - 1 Then
        ActiveSheet.Unprotect
        Application.EnableEvents = False
            Selection.ListObject.ListRows.Add AlwaysInsert:=False
        ActiveSheet.Unprotect
    Else
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowInsertingRows:=True, AllowDeletingRows:=True, AllowSorting:=True, _
        AllowFiltering:=True, AllowUsingPivotTables:=True
        Application.EnableEvents = True
    End If
End If
End Sub

 

[ByBaklan]

Yusuf Hocam öncelikle ilginiz için teşekkür ederim.
Kodu kullandım. İlk önce çalışmadı. Üzerinde uğraştıktan sonra aşağıdaki hali ile çalışıyor artık.
Fakat şimdi de işlemi yaptıktan sonra önce tablonun ilk satırını seçiyor. Aşağıya çağırınca geliyor. Fakat bu arada ekran şöyle bir gidip geliyor.
Eğer Aktif olan hücrenin satır numarasını kodun başında söyleyebilirsem yukarıya çıkmayacak diye düşünüyorum.
Fakat yapamadım.
Destek verebilir misiniz?

Doküman da ekte.

Şimdiden tekrar teşekkür ederim.

Private Sub Worksheet_Change(ByVal Target As Range)
'Dim X as
Application.ScreenUpdating = False
On Error Resume Next
        X = ActiveCell.Row
'        MsgBox X, vbInformation
If Not Intersect(Target, [E:E]) Is Nothing Then
    For I = X To Cells(65536, "E").End(xlUp).Row
'        MsgBox ActiveCell.Row, vbInformation
        If Target.Row = Cells(Rows.Count, "E").End(xlUp).Row - 1 Then
            ActiveSheet.Unprotect
            Application.EnableEvents = False
            Selection.ListObject.ListRows.Add AlwaysInsert:=False
            ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
            Application.EnableEvents = True
        End If
    Next
End If
Application.ScreenUpdating = True
Range("B" & I - 1).Select
End Sub

 

[Korhan Ayhan]

Dosyanızda bir sorun görünmüyor. Kod normal şekilde çalışıyor.

 

[YUSUF44]

Kodu denediğimde düzgün çalışıyordu. Şimdi inceledim kodu yazarken düşündüğüm şeyi yazmamışım: Koddaki Else satırından önceki Unprotect ifadesini aslında Protect olarak yazmak istemiştim, yani Activesheet.Protect olmalıydı. Yine de bu haliyle düzgün çalışıyordu. Çünkü Else'den sonraki kısım eğer değişen hücre E sütunundaki sondan bir önceki hücre değilse sayfayı koruyor. Düşündüğüm gibi olsaydı tek farkı satır ekledikten sonra doğrudan kilitlenecekti.