Otomatik Satır Ekleme

[poetika]

Ekteki dosyada A12 hücresinden G12 hücresine kadar veri girdiğimde aşağıya ardışık sıra no atarak otomatik satır eklenmesini istiyorum. Ayrıca sayfayı korumaya aldığımda otomatik satır ekleme işlevi bozulmasın.

 

[YUSUF44]

Aşağıdaki kodları sayfa adına sağ tıklayıp Kod görüntüle deyince açılan sayfaya yapıştırıp deneyiniz:

Private Sub Worksheet_Change(ByVal Target As Range)
son = Cells(Rows.Count, "A").End(3).Row
If Intersect(Target, Range("B12:G" & son - 1)) Is Nothing Then Exit Sub
a = Target.Row
If Cells(a, "B") <> "" And Cells(a, "C") <> "" And Cells(a, "F") <> "" And Cells(a, "G") <> "" Then
    Application.EnableEvents = False
        Rows(a).Copy: Rows(a + 1).Insert Shift:=xlDown
        Range("A" & a + 1 & ":G" & a + 1).ClearContents
        Cells(son + 1, "G").Formula = "=SUM(G12:G" & son & ")"
        Cells(a + 1, "A") = a - 10
        Cells(son, "B").Select
    Application.EnableEvents = True
End If
End Sub

 

[poetika]

Aşağıdaki kodları sayfa adına sağ tıklayıp Kod görüntüle deyince açılan sayfaya yapıştırıp deneyiniz:

Private Sub Worksheet_Change(ByVal Target As Range)
son = Cells(Rows.Count, "A").End(3).Row
If Intersect(Target, Range("B12:G" & son - 1)) Is Nothing Then Exit Sub
a = Target.Row
If Cells(a, "B") <> "" And Cells(a, "C") <> "" And Cells(a, "F") <> "" And Cells(a, "G") <> "" Then
    Application.EnableEvents = False
        Rows(a).Copy: Rows(a + 1).Insert Shift:=xlDown
        Range("A" & a + 1 & ":G" & a + 1).ClearContents
        Cells(son + 1, "G").Formula = "=SUM(G12:G" & son & ")"
        Cells(a + 1, "A") = a - 10
        Cells(son, "B").Select
    Application.EnableEvents = True
End If
End Sub

Sayfayı korumaya alınca kod çalışmıyor.

 

[YUSUF44]

Private Sub Worksheet_Change(ByVal Target As Range)
son = Cells(Rows.Count, "A").End(3).Row
If Intersect(Target, Range("B12:G" & son - 1)) Is Nothing Then Exit Sub
a = Target.Row
If Cells(a, "B") <> "" And Cells(a, "C") <> "" And Cells(a, "F") <> "" And Cells(a, "G") <> "" Then
    Application.EnableEvents = False
        ActiveSheet.Unprotect
        Rows(a).Copy: Rows(a + 1).Insert Shift:=xlDown
        Range("A" & a + 1 & ":G" & a + 1).ClearContents
        Cells(son + 1, "G").Formula = "=SUM(G12:G" & son & ")"
        Cells(a + 1, "A") = a - 10
        Cells(son, "B").Select
        ActiveSheet.Protect
    Application.EnableEvents = True
End If
End Sub

 

[poetika]

Private Sub Worksheet_Change(ByVal Target As Range)
son = Cells(Rows.Count, "A").End(3).Row
If Intersect(Target, Range("B12:G" & son - 1)) Is Nothing Then Exit Sub
a = Target.Row
If Cells(a, "B") <> "" And Cells(a, "C") <> "" And Cells(a, "F") <> "" And Cells(a, "G") <> "" Then
    Application.EnableEvents = False
        ActiveSheet.Unprotect
        Rows(a).Copy: Rows(a + 1).Insert Shift:=xlDown
        Range("A" & a + 1 & ":G" & a + 1).ClearContents
        Cells(son + 1, "G").Formula = "=SUM(G12:G" & son & ")"
        Cells(a + 1, "A") = a - 10
        Cells(son, "B").Select
        ActiveSheet.Protect
    Application.EnableEvents = True
End If
End Sub

Bu sefer de tüm verileri girdikten sonra satır ekleyebilmek için parola soruyor.

 

[YUSUF44]

Kodu bu haliyle örnek dosyanızda kullandığımda öyle bir sıkıntı oluşmuyor. Eğer siz sayfayı korurken şifre belirlediyseniz doğal olarak korumayı kaldırmak için şifre isteyecektir.

Kodda şifre girmek için Unprotect ve Protect satırlarının devamına birer boşluk bırakıp tırnak içinde şifreyi yazabilirsiniz:

ActiveSheet.Unprotect "123"

ActiveSheet.Protect "123"

gibi.