Bir Sayfadan Diğerine Şartlı Veri Aktarımı

[sessizeal]

Sıra No İşlem Tarihi Firma Adı Miktar

1 05.05.2016 Ahmet 500
2 05.05.2016 Mehmet 1.000
3 06.05.2016 Ali 2.000
4 06.05.2016 Mustafa 1.500
5 06.05.2016 Veysel 1.000
6 07.05.2016 Salih 500
7 07.05.2016 Kazım 2.000


Merhaba. Farklı bir sorum olacak sizlere. Sayfa 1' de yukarıdaki gibi veri girişlerim mevcut. Bu verileri ikinci sayfama aynı tarih ve sırayla kayıt etmek istiyorum. Yalnız şöyle bir sıkıntı söz konusu ikinci sayfamda bilgi kaydı yapılacak yere manuel giriş de söz konusu. Bu durumda ikinci sayfanın görünümü aşağıdaki gibi olacak;

Sıra No İşlem Tarihi Firma Adı Miktar

1 05.05.2016 Ahmet 500
2 05.05.2016 Mehmet 1.000
3 05.05.2016 Manuel Kayıt
4 05.05.2016 Manuel Kayıt
5 06.05.2016 Ali 2.000
6 06.05.2016 Mustafa 1.500
7 06.05.2016 Veysel 1.000
8 06.05.2016 Manuel Kayıt
9 07.05.2016 Salih 500
10 07.05.2016 Kazım 2.000

Sorum şu; ikinci sayfaya yaptığım manuel girişler birinci sayfadan aldığım verilerin sırasını bozmadan nasıl ilerleyebilir ve manuel giriş sonrasındaki hücre belirlenen formülle yine sayfa 1 deki aynı veriyi aynı sırayla çekebilir mi?

 

[YUSUF44]

Aşağıdaki kodları Sayfa1'in kod bölümüne yapıştırınız. Bu kodlarla B220000 aralığına veri girdiğinizde B, C ve D hücreleri doluysa Sayfa2'nin ilk boş satırına aktarır ve A sütununa otomatik sıra numarası verir.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B2:D20000")) Is Nothing Then Exit Sub
a = Target.Row
If Cells(a, "B") <> "" And Cells(a, "C") <> "" And Cells(a, "D") <> "" Then
    yeni = Sheets("Sayfa2").Cells(Rows.Count, "A").End(3).Row + 1
    Cells(a, "A") = a - 1
    Range(Cells(a, "B"), Cells(a, "d")).Copy Sheets("Sayfa2").Cells(yeni, "B")
    Target.Offset(0, 1).Select
End If
End Sub

Aşağıdaki kodları ise Sayfa2'nin kod bölümüne yapıştırınız. Bu kodlarla B220000 aralığına veri girdiğinizde B, C ve D hücreleri doluysa (İster Sayfa1'den aktarılsın, ister manuel girilsin) A sütununa otomatik sıra numarası verir.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B2:D20000")) Is Nothing Then Exit Sub
a = Target.Row
If Cells(a, "B") <> "" And Cells(a, "C") <> "" And Cells(a, "D") <> "" Then
    Cells(a, "A") = a - 1
End If
End Sub