Onay verilince otomatik satır ekleme

[policeman]

Merhaba...
Bir satırda koşullu biçimlendirme ve formüllerle desteklenmiş veriler var.Son sütuna gelince hücreye (mesela; X veya Tamam) yazıp entere bastığımda alta yeni boş satır eklensin ama satırdaki koşullu biçimlendirme ve formüller devam etsin...Mümkün mü?...
Kolay gelsin...

 

[Korhan Ayhan]

Selamlar,

Bu istemiş olduğunuz işlemi VERİ menüsünden LİSTELE-LİSTE OLUŞTUR özelliği ile rahatlıkla yapabilirsiniz. Tablonuza bu özelliği uyguladıktan sonra son satıra işlem yaptıkça en son satırın özelliklerini taşıyan yeni bir satır tablonuza eklenecektir.İnceleyiniz.

 

[policeman]

Sn. Korhan Ayhan
Veri menüsünde Listele seçeneğini bulamadım

 

[Korhan Ayhan]

Selamlar,

Tablonuzun herhangi bir hücresini seçin ve CTRL+L tuşlarına basın. Aynı sonuca ulaşacaksınız.

 

[policeman]

Sn. Korhan Ayhan
özür dilerim yazılanları uygulayamıyorum
excel sürümüme baktım 2002 yazıyor acaba bu yüzdenmi...
Saygılarımla...

 

[Korhan Ayhan]

Selamlar,

Pardon. Kullanığınız versiyona dikkat etmemişim. Evet "Liste" özelliği 2003 versiyonuyla beraber kullanılmaya başlanmıştır.

Sizin için makrolu çözüm hazırlayabiliriz.

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı incelermisiniz. Sarı renkli sütuna "x" yazın ve deneyin. Sanırım kodu kendi dosyanıza uyarlayabilirsiniz.

Kullanılan kod; (Sayfanın kod bölümüne uygulayın.)

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Son
    If Intersect(Target, [E:E]) Is Nothing Then Exit Sub
    If UCase(Target) = "X" Then
    Range("A" & Target.Row & ":D" & Target.Row).Copy
    Cells(Target.Row + 1, "A").Insert Shift:=xlDown
    Range("A" & Target.Row + 1 & ":C" & Target.Row + 1).ClearContents
    Application.CutCopyMode = False
    Cells(Target.Row + 1, "A").Select
    End If
Son:
End Sub

 

[policeman]

Sn. Korhan Ayhan
İlginize teşekkürler....
Makro konusunda fazla bir bilgim yok ama uygulamaya çalışacağım..
Saygılarımla..

 

[policeman]

Sn. Korhan Ayhan
-----------------------------------------------------------------------
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [W:W]) Is Nothing Then Exit Sub
If UCase(Target) = "X" Then
Range("A" & Target.Row & ":V" & Target.Row).Copy
Cells(Target.Row + 1, "A").Insert Shift:=xlDown
Range("A" & Target.Row + 1 & ":U" & Target.Row + 1).ClearContents
Application.CutCopyMode = False
Cells(Target.Row + 1, "A").Select
End If
Son:
End Sub
-------------------------------------------------------------------------
Makronuzu bu şekilde uyguladım ama satır ekledi,değerleri eklemedi..
A'da EĞER'li formül
BCDE'de Veri doğrulama
F'de seçme kutusu
GHIJKLM'de bilgiler
NOPQRSTUV'de ALTTOPLAM'lı formül
ve hepsinde koşullu biçimlendirme mevcut
W onay yani X yazıyorum....
-------------------------------------------------------------------------
Tekrar yardımınızı bekliyorum...
Saygılarımla...

 

[Korhan Ayhan]

Selamlar,

Dosyanızı eklermisiniz.

 

[policeman]

Öğrenmeye devam

Sn. Korhan Ayhan
Dosyamı ekledim,inşallah çözüm olursunuz...
Saygılarımla...

 

[Korhan Ayhan]

Selamlar,

Kodu aşağıdaki şekilde değiştirip denermisiniz.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Son
    If Intersect(Target, [W:W]) Is Nothing Then Exit Sub
    If UCase(Target) = "X" Then
    Application.EnableEvents = False
    Range("A" & Target.Row & ":X" & Target.Row).Copy
    Cells(Target.Row + 1, "A").Insert Shift:=xlDown
    Range("F" & Target.Row + 1 & ":H" & Target.Row + 1).ClearContents
    Range("J" & Target.Row + 1).ClearContents
    Range("M" & Target.Row + 1 & ":X" & Target.Row + 1).ClearContents
    Application.CutCopyMode = False
    Cells(Target.Row + 1, "B").Select
    End If
Son:
    Application.EnableEvents = True
End Sub

 

[policeman]

Sn. Korhan Ayhan
Elinize,bilginize sağlık;çok teşekkürler...
Saygılar....

 

[rustuuslu]

korhan bey diyelimki 1.sayfada A10 den D10 kadar tablo var.bu tablonun aynısı 2. sayfa A15 den D15 kadar da tablo var.Sayfa 1 deki tablosunun aynısını sayfa 2 de de nasıl satır ekleme yaptırırız.yani 1 sayfada eklenen tablo 2. sayfadada eklenecek.bunu yaparken 2.sayfada işlem yapmayalım

 

[policeman]

Sn. Korhan Ayhan
Tablomu değiştirince makroyu uygulayamadım...
Tekrar yardımcı olurmusunuz?...
Saygılarımla...

 

[policeman]

sayfa korumasıda konulabilirmi???
Saygılar...

 

[policeman]

Özür...
Güncel kalsın istedim;hala yardım bekliyorum..
Kolay gelsin..