seçilen veriyi aktarma

ozcanya

Altın Üye
Katılım
3 Haziran 2006
Mesajlar
414
Excel Vers. ve Dili
excel 2003 Türkçe
Altın Üyelik Bitiş Tarihi
04-04-2025
Arkadaşlar Daha Önce Veri aktarımı ile ilgili başlık açtım ama çalışmamı yapamadım.Sizden ricam Seçdiğim veriyi diğer sayfaya aktarma ve aktarılan verinin yanında tarih (aktarılan) yazması istiyorum.
yardımlarınız için teşekkür ederim.İyi çalışmalar
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,680
Excel Vers. ve Dili
Excel 2019 Türkçe
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Sayfa2.Rows(Sayfa2.[a65536].End(3).Row + 1) = Sayfa1.Rows(Target.Row).Value
    Sayfa1.Rows(Target.Row).Delete
End Sub
 

ozcanya

Altın Üye
Katılım
3 Haziran 2006
Mesajlar
414
Excel Vers. ve Dili
excel 2003 Türkçe
Altın Üyelik Bitiş Tarihi
04-04-2025
hocam örnek dosya eklemediz mümkün mü?
 

Ayhan Ercan

Özel Üye
Katılım
10 Ağustos 2005
Mesajlar
1,573
Excel Vers. ve Dili
Microsoft 365- Türkçe
Merhaba

Alternatif....
Ek dosyayı inceleyiniz...

Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim hcr As Range, son As Long
If Intersect(Target, Range("a1:a19")) Is Nothing Then Exit Sub
son = Sheets("taşınan").Range("A65536").End(3).Row + 1
Set hcr = Sheets("taşınan").Range("A" & son)
For i = 0 To 4
hcr.Offset(0, i) = Target.Offset(0, i)
Next i
hcr.Offset(0, 5) = Date
Rows(Target.Row).Delete
End Sub
 

ozcanya

Altın Üye
Katılım
3 Haziran 2006
Mesajlar
414
Excel Vers. ve Dili
excel 2003 Türkçe
Altın Üyelik Bitiş Tarihi
04-04-2025
ayhan hocam çift tıkladığımda değil de Düğme Yardımı ile Yapabilirmiyim acaba (özür)
 

Ayhan Ercan

Özel Üye
Katılım
10 Ağustos 2005
Mesajlar
1,573
Excel Vers. ve Dili
Microsoft 365- Türkçe
ayhan hocam çift tıkladığımda değil de Düğme Yardımı ile Yapabilirmiyim acaba (özür)
Tekrar Merhaba,,


Düğmeye atamak istiyorsanız aşağıdaki kodları kullanın...

Kod:
Private Sub CommandButton1_Click()
Dim hcr As Range, son As Long
Application.ScreenUpdating = False
If Intersect(ActiveCell, Range("a1:a" & [A65336].End(3).Row)) Is Nothing Then Exit Sub
son = Sheets("taşınan").Range("A65536").End(3).Row + 1
Set hcr = Sheets("taşınan").Range("A" & son)
For i = 0 To 4
hcr.Offset(0, i) = ActiveCell.Offset(0, i)
Next i
hcr.Offset(0, 5) = Date
Rows(ActiveCell.Row).Delete
End Sub
 

ozcanya

Altın Üye
Katılım
3 Haziran 2006
Mesajlar
414
Excel Vers. ve Dili
excel 2003 Türkçe
Altın Üyelik Bitiş Tarihi
04-04-2025
ayhan bey hata verdi yoksa ben mi yapamadım.
 

ozcanya

Altın Üye
Katılım
3 Haziran 2006
Mesajlar
414
Excel Vers. ve Dili
excel 2003 Türkçe
Altın Üyelik Bitiş Tarihi
04-04-2025
zaman ayırdınız çok teşekkür ederim.iyi çalışmalar dilerim.
(düğme kilitli acaba yerini değiştiremedim)
 
Son düzenleme:

ozcanya

Altın Üye
Katılım
3 Haziran 2006
Mesajlar
414
Excel Vers. ve Dili
excel 2003 Türkçe
Altın Üyelik Bitiş Tarihi
04-04-2025
teşekkür ederim. kusura bakmayın
 
Üst