Sayfaları aktaran kod'a ilave

1Al2Ver

Altın Üye
Katılım
5 Kasım 2007
Mesajlar
4,710
Excel Vers. ve Dili
64 Bit TR - Microsoft Office 365 - Win11 Home
Altın Üyelik Bitiş Tarihi
04-01-2026
İyi akşamlar,

Ek'li dosyada örneği olan kod, "anasayfa" isimli sayfanın A,B ve C kolonlarındaki bilgileri "B" kolonundaki isime göre sayfalara bire bir aktarmaktadır.

Ben "anasayfa" isimli sayfadaki D ve E sütunlarının da aynı yöntemle diğer sayfalara aktarılmasını arzuluyorum, teşekkür ederim.
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,232
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E:E]) Is Nothing Then Exit Sub
On Error GoTo son
If Target.Value = "" Then Exit Sub
sat = Sheets(Target.Offset(0, -3).Value).Cells(65536, "B").End(xlUp).Row + 1
Sheets(Target.Offset(0, -3).Value).Cells(sat, "A").Value = Target.Offset(0, -4).Value
Sheets(Target.Offset(0, -3).Value).Cells(sat, "B").Value = Target.Offset(0, -3).Value
Sheets(Target.Offset(0, -3).Value).Cells(sat, "C").Value = Target.Offset(0, -2).Value
Sheets(Target.Offset(0, -3).Value).Cells(sat, "D").Value = Target.Offset(0, -1).Value
Sheets(Target.Offset(0, -3).Value).Cells(sat, "E").Value = Target.Offset(0, 0).Value
son:
End Sub
 

1Al2Ver

Altın Üye
Katılım
5 Kasım 2007
Mesajlar
4,710
Excel Vers. ve Dili
64 Bit TR - Microsoft Office 365 - Win11 Home
Altın Üyelik Bitiş Tarihi
04-01-2026
Merhaba,

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E:E]) Is Nothing Then Exit Sub
On Error GoTo son
If Target.Value = "" Then Exit Sub
sat = Sheets(Target.Offset(0, -3).Value).Cells(65536, "B").End(xlUp).Row + 1
Sheets(Target.Offset(0, -3).Value).Cells(sat, "A").Value = Target.Offset(0, -4).Value
Sheets(Target.Offset(0, -3).Value).Cells(sat, "B").Value = Target.Offset(0, -3).Value
Sheets(Target.Offset(0, -3).Value).Cells(sat, "C").Value = Target.Offset(0, -2).Value
Sheets(Target.Offset(0, -3).Value).Cells(sat, "D").Value = Target.Offset(0, -1).Value
Sheets(Target.Offset(0, -3).Value).Cells(sat, "E").Value = Target.Offset(0, 0).Value
son:
End Sub
Sayın Necdet Yeşertener, merhabalar, teşekkür ederim, hem sorunum çözüldü hem de yolunu öğrendim, sizlere ne kadar minnettar kalsak azdır, sağolun, varolun, saygılar sunarım.
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,232
Excel Vers. ve Dili
Ofis 365 Türkçe
Rica ederim Sayın 1Al2Ver,

Saygı karşılıklı olur, iyi geceler diliyorum.
 
Üst