Makro ile butona bağlı kalmadan aktarma

[msanli]

Yeni konu açmadan bu işi halletmeye çalıştım ama, başarılı olamadım.

Yapmak istediğim:
Belli bir şablonum var. Bu tabloda c2:c14 ce d3:d14 arasında verilerim var. Bu değerler sürekli olarak değişiyor. Bu verileri bir şekilde başka bir sayfada kayıt altına almak istiyorum.

c2:c14 arasına girilen değerleri, a3'den başlayarak, m3 hücresine kadar, d3:d14arasına giren değerleride n3'den x3 hücresine kadar aktaracak ve yeni veri girdikce liste aşağıya doğru uzayacak.

dosyanın boyutundan dolayı, dosya ekleyemiyorum.

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

 

[fedeal]

dosyanız ekte,saygılar.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("c2:c14")) Is Nothing Then GoTo atla:
fdl = Sheets("sayfa2").Range("A65000").End(xlUp).Row + 1
For i = 2 To 14
Sheets("sayfa2").Cells(fdl, i - 1).Value = Cells(i, 3).Value
Sheets("sayfa2").Cells(fdl, i + 11).Value = Cells(i, 4).Value
Sheets("sayfa2").Cells(fdl, "y").Value = Now
Next
Exit Sub
atla:
If Intersect(Target, Range("d3:d14")) Is Nothing Then Exit Sub
fdl = Sheets("sayfa2").Range("A65000").End(xlUp).Row + 1
For i = 2 To 14
Sheets("sayfa2").Cells(fdl, i - 1).Value = Cells(i, 3).Value
Sheets("sayfa2").Cells(fdl, i + 11).Value = Cells(i, 4).Value
Sheets("sayfa2").Cells(fdl, "y").Value = Now
Next
End Sub

 

[msanli]

Teşekkür ederim, fakat verileri girince ekteki dosyada olduğu gibi verileri mükerrer aktarıyor. Aynı kodları kendi dosyamdada denedim, sonuç aynı
Ve, D14'deki veriyi almıyor...

 

[fedeal]

Change olayına yazdıgımız için her değişiklikte aktarıyor.sayfanın start komutları arasında SelectionChange olayı var oda bahsettigimiz aralıkta herhangibi bir hücre seçilince çalışacak oda pek verimli olmaz sağ mause tıklamayla yapsak onunda butondan farkı olmayacak aralıga makroyla veri alıyorsanız o makronun sonuna kodları eklemek en mantıklısı, dosyayı kullanış şekline göre çözüm bulunur diye düşünüyorum.dosyanızı farklı kaydedip içerigini temizleyip ekleme şansınız varsa bakalım.

 

[msanli]

Sorunu bir buton ekleyerek çözdüm. Gerçi çok pratik olmuyor ama, yinede iş görüyor.
İlginize teşekkür ederim.

 

[msanli]

selam,
Ekte gönderdiğim kodlarda mesajbox çalışmıyor. neden olabilir?

Kolay gelsin...

 

[fedeal]

sub n()
fdl = Sheets("sayfa2").Range("A65000").End(xlUp).Row + 1
For i = 2 To 14
Sheets("sayfa2").Cells(fdl, i - 1).Value = Cells(i, 3).Value
Sheets("sayfa2").Cells(fdl, i + 11).Value = Cells(i, 4).Value
Sheets("sayfa2").Cells(fdl, "y").Value = Now
Next
[COLOR="Red"]'msgboxu buraya yazın[/COLOR]
End Sub

Sayfanın start komutuyla birlikte hepsini yazmışsınız exit sub ta makro sonlanıyor msgbox satırını exitsubun üstüne kopyalayıp exit sub da dahil end suba kadar alttaki satırları silin,