Hücre içeriği değişince yapması gerekenler

[dragon44760]

Herkese iyi günler...

Ekte bulunan dosyada bir şeyler yapmaya çalıştım lakin istediğimi yerine getiremedim. "P3" hücresinde bulunan tarih değiştiğinde sırasıyla şunları yapmasını istiyorum;
1. "P7" hücresini kopyalamalı ve "U" sütununda ilk boş hücreye özel yapıştır-değerleri yaparak yapıştırmalı.
2. "U" sütununda yukarıdaki yapıştırma işlemini yaptığı hücrenin bir üstündeki hücreyi kopyalayıp "P910" birleştirilmiş hücresine yazmasını istiyorum.

Lakin "P9" hücresine şifreli giriş yapılabilmekte bu sorun yukarıdaki (2. maddedeki) yapıştırma işleminde karşımıza çıkacaktır. "P9" hücresinin şifresi ise "T1" hücresindedir ve değişkendir.


Konuyla ilgili yardımcı olacaklara şimdiden teşekkürler...

 

[dragon44760]

Arkadaşlar bu konuda fikri olan ve bana yardımcı olacak kimse yok mu_?

 

[Korhan Ayhan]

Selamlar,

Sayfanızın kod bölümündeki Private Sub Worksheet_Change(ByVal Target As Excel.Range) kodunu silip aşağıdaki kodu uygulayıp denermisiniz.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    On Error GoTo Son
    If Intersect(Target, [P3]) Is Nothing Then Exit Sub
    Cells(65536, "U").End(3).Offset(1, 0) = Range("P7")
    ActiveSheet.Unprotect Password:="123456"
    Range("P9") = Cells(65536, "U").End(3).Offset(-1, 0)
Son:
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True, Password:="123456"
End Sub

 

[dragon44760]

P3 hücresinde veri doğrulama olduğundan benim yazdığım kodlar işe yaramıyormuş. Lakin veri doğrulamayı iptal edince yani veri yazılarak giriş yapılması sağlanınca aşağıdaki kodlarla istediğimi yaptım.

Yardımcı olan tüm arkadaşlara teşekkürler...

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  If Target = Cells(3, 16) Then Call Yenile
End Sub


Sub Yenile()
MsgBox "Lütfen Bekleyiniz İşlemler Yapılıyor.", vbOKOnly + vbInformation, "BEKLEYİN..!"
Application.Wait Now + TimeValue("00:00:03")
Range("p7").Select
Selection.Copy
Range("u65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

ActiveCell.Offset(-1, 0).Select
Selection.Copy
Range("v1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False
Range("m3").Select

MsgBox "İşlem Bitti.", vbOKOnly + vbInformation, "İŞLEM TAMAMLANDI..!"
End Sub

 

[Korhan Ayhan]

Selamlar,

VERİ DOĞRULAMA kullanılmış hücreyi değiştirdiğinizde de kod çalışır. Benim önerdiğim kodu denediniz mi?

 

[dragon44760]

Sn. Korhan Ayhan denedim lakin o da işe yaramadı_?
İlgin için çok teşekkürler...

 

[Korhan Ayhan]

Selamlar,

Ekteki dosyayı denermisiniz. Eğer varsa olmayan kısmınıda açıklarmısınız.

 

[dragon44760]

Sn. Korhan Ayhan denedim ancak hiçbir işlem yapmadı.

Neyse çok önemli değil ben yukarıda vermiş olduğum kodlarla ve doğrulamayı iptal ederek yapmak istediğimi yaptım.

 

[Korhan Ayhan]

Selamlar,

Eklemiş olduğum örnek dosyada P3 hücresinden her seçim yaptığımda U sütununa alt alta hesaplamalar listelenmektedir. Sizde bu şekilde olmuyor mu?

 

[dragon44760]

İlginçtir ama bende olmadı. Neden acaba_?