Satır silindiğinde yeni satır açtırma

[SSAFFAK]

Değerli Üstadlarım aşağıdaki makroyu kendi sayfama uyarlamaya çalıştım. Bir kısmı çalıştı fakat asıl istediğim sayfada çalışmadı. Şöyleki ekteki dosyada LİSTE sayfasında 30 kişi listesinden satır sildiğim anda bağlı bulunduğu diğer sayfalarda otomatik siliyor, yukarı kaydırıyor ve 30. satır boş kalıyor. Fakat diğer sayfalarda yapılanlar LİSTE sayfasında olmuyor. ( LİSTE sayfasından bir kişiyi sildiğim anda liste yukarı kayacak ve listenin sonuna 30. sıraya yeni satır oluşturmasını istiyorum.)
Yardımcı olabilirmisiniz.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column <> 1 Then Exit Sub
For i = 1 To Sheets.Count
Sheets(i).Cells(Selection.Row, 1).Resize(, 10).Delete
Next i
Cancel = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim s%, i%, a%
If Intersect(Target, Range("B4:B65536")) Is Nothing Then Exit Sub
On Error Resume Next
For a = 1 To Sheets.Count
For i = 4 To Sheets(a).Range("B65536").End(3).Row
If Sheets(a).Cells(i, 2).Value = "" Then
Sheets(a).Cells(i, 1).Value = ""
Else
s = s + 1
Sheets(a).Cells(i, 1).Value = s
End If
Next i
s = Empty
Next a
i = Empty: a = Empty: s = Empty
End Sub

 

[Korhan Ayhan]

Satır eklenecekse komple satırı silmek yerine içindeki verileri silmeniz daha mantıklı olmaz mı?

 

[SSAFFAK]

Korhan Hocam bu listeyi birkaç farklı birim kullanacak. Listeden bir kişi çıkarıldığında yeni eklenecek kişinin kıdemi düşük olacağından listenin en altından sıraya girmesi gerekiyor. Aslında uyarlamaya çalıştığım makro ile diğer saylarda tam istediğim gibi çalışıyor fakat asıl yapması gereken LİSTE sayfasında yapmıyor.

 

[SSAFFAK]

Değerli hocalarım konu hakkında fikir verebilecek yada yol gösterebilecek var mıdır ?

 

[ÖmerFaruk]

Double click ile silme yapmak istediğiniz satırda hangi sütunlar silinecek?
Diğer sayfalarda silinen bu satırdaki isimle aynı isme sahip olan hangi sütunlar silinecek?
Satırlar komple mi silinecek?

 

[SSAFFAK]

NextLevel hocam "B8-B38" arasındaki herhangi bir satır komple silinecek ama 30.sıraya yeni (üstteki satırların formatında) satır açtırmaya çalışıyoruz.
Yada "B" sütunundan itibaren silerse alttakileri yukarı çıkartacak ve 30. satırımız boş kalmış olacak.

 

[ÖmerFaruk]

Şöyle sorayım ve sorularıma tek tek cevap verirseniz sevinirim.

1. LİSTE sayfasında A8:A37 aralığında bir hücreye mi çift tıklayınca kodlar çalışacak?
2. Değilse ne zaman çalışacak?

Lütfen aşağıdkailer için ARALIK belirtin. tıklanan satır 15 mesela A15:K15 silinecek gibi. Hiç bir şey silinmeyecekse onu da belirtin.

3. Kodlar çalıştığında LİSTE sayfasında hangi hücre aralığı silinecek?
4. Kodlar çalıştığında KODLAR sayfasında hangi hücre aralığı silinecek?
5. Kodlar çalıştığında MESAİ FİŞİ sayfasında hangi hücre aralığı silinecek?
6. Kodlar çalıştığında KAPAK sayfasında hangi hücre aralığı silinecek?
7. Kodlar çalıştığında GECE NÖBET SAYILARI sayfasında hangi hücre aralığı silinecek?
8. Kodlar çalıştığında FAZLA MESAİ sayfasında hangi hücre aralığı silinecek?


9. Satırlarınızda formüller var. Silme sonrası 30. satıra yine benzer formüller yazılacak mı?

 

[SSAFFAK]

-Hocam A8:A37 aralığında satırlardan birini sildiğimizde kod çalışacak.
-Örneğin Satır 15 silindiğinde 15. satır komple silinecek ve 37. satıra yeni satır sırası açılacak.
-Listemiz 30 kişi sabit sayılı olduğundan en alta 30. kişi olarak yeni satır açtırmak istiyoruz.
-Sizin dediğiniz gibi 30. satıra benzer formüller yazılacak. (satır numarası ve "AM" sütunundaki formüller),
-Aynı işlemi "Kapak","Gece Nöbet sayıları" ve "Fazla Mesai" sayfalarında yapacak.
-KODLAR sayfasında devrik dönüşüm olduğu için orayı kapsamasa da olur.

NextLevel hocam şuanda "LİSTE" sayfasından bir kişi sildiğimizde başka bir yerden uyarlamaya çalıştığım makroyla "Kapak","Gece Nöbet sayıları" ve "Fazla Mesai" sayfalarında kişi satırını siliyor ve 30. satır boş kalıyor. Ama "LİSTE" sayfasında olmuyor.
Hocam biraz karmaşık oldu. Başınızı ağrıttım. Kusuruma bakmayın ne olur. Hocam eğer uğraştırıcı bi yolsa hiç uğraşmayın. Emeğiniz çok büyük, değerli vaktinizi almak istemem.

 

[ÖmerFaruk]

Dosyanızın yedeğini alın.
LİSTE sayfasındaki kodları tamamen silerek aşağıdakini yapıştırın
Diğer sayfadaki verileriniz zaten formülle geldiğinden oralarda SİLME İŞLEMİne gerek olmadığını düşünüyorum.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, Range("B8:B37")) Is Nothing Then Exit Sub
    sil = Selection.Row
    Range("B" & sil, "AZ" & sil).ClearContents
    If sil <> 37 Then
        Range("B" & sil + 1, "AZ37").Copy Range("B" & sil, "AZ36")
        Range("B37:AZ37").ClearContents
    End If
    Cancel = True
End Sub

 

[SSAFFAK]

Hocam şuanda bakma şansım yok. Nöbetten çıkınca bakıp dönüş yaparım size..Hocam hakkınızı helal edin. Uğraştırdım sizi. Allah razı olsun.

 

[SSAFFAK]

Saygıdeğer NextLevel hocam kusura bakmayın ancak bakabildim. Formül çalışmadı. Yani double click yapınca hiçbirşey değişmiyor.

 

[ÖmerFaruk]

Bir yerde ufak bir hata yapıyorsunuz. Ben denedim ve sorunsuz çalıştı.

 

[SSAFFAK]

Hocam şimdi farkettim hatamı Hocam biliyorum yordum sizi ama son bir ricam olabilir mi acaba? Bu silme olayını B sütunu yerine soldaki satır numaralarına göre yaptırabilir miyiz. Yani 8-38 satır numaralarına uyarlanabilirmi bu işlem. Çünkü kişinin ismini düzeltmek için double click yapınca listeden siliyor.

 

[ÖmerFaruk]

If Intersect(Target, Range("B8:B37")) Is Nothing Then Exit Sub
yerine
If Intersect(Target, Range("A8:A37")) Is Nothing Then Exit Sub

 

[SSAFFAK]

Hocam "A" sütunu değil en soldaki satır numarasından demek istemiştim.

 

[SSAFFAK]

Saygıdeğer NextLevel hocam bu silme komutuna double click sonrası "Kişiyi silmek istediğinizden eminmisiniz" ve "evet-hayır" şeklinde mesajbox kutusu nasıl ekleyebiliriz bu makroya. Hocam biliyorum fazla oldum. Hakkınızı helal edin. Ne yapsak hakkınızı ödeyemeyiz. Bu sizden son ricam..

 

[ÖmerFaruk]

Hocam "A" sütunu değil en soldaki satır numarasından demek istemiştim.

Buna neden ihtiyaç duyduğunu anlamdım. Ve ben bunu yapamam.

Mesaj için aşağıdkai kodu kullanabilirsin

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, Range("A8:A37")) Is Nothing Then Exit Sub
    Sil = Selection.Row
    Cevap = MsgBox(Sil + 1 & ". kaydı silmek istiyor musunuz?", vbYesNo)
    If Cevap = 6 Then
        Range("B" & Sil, "AZ" & Sil).ClearContents
        If Sil <> 37 Then
            Range("B" & Sil + 1, "AZ37").Copy Range("B" & Sil, "AZ36")
            Range("B37:AZ37").ClearContents
        End If
        Cancel = True
    End If
End Sub

 

[SSAFFAK]

Hocam Allah razı olsun sizden. Tam istediğim şey de buydu. Yanlışlıkla silinmesine karşı önlem olacak bu yol. Elinize emeğinize yüreğinize sağlık. Herşey gönlünüzce olsun. Çok çok teşekkür ederim..