Cari tahsilatların kasa sahifesine aktarılması

[kemal turan]

Merhaba Üstadlar,
Cari sahifesine girilen tahsilatların kasa sahifesine aktarılmasına ihtiyacım var.
Konu ile ilgili istediklerim ek dosyadadır.
Şimdiden çok teşekkür ederim.

 

[Failimechul]

Merhaba Sayın 'kemal turan'

Bütün bu söylediklerinizi bir düğme ile yapmak ister miydiniz?

 

[kemal turan]

Merhaba Sn. failimeçhul kardeşim,
Gün sonunda bugüne ait tahsilatların tamamını süzüp bir kerede toplu olarak kasa sahifesine aktaran kod mevcut.Bu aktarma işleminin elemanlar bazen unutuyorlar.
Ben her veri girişinde bu aktarma işinin yapılabilmesini farkl dosyalarda kulllanmayı da düşündüğümden böyle bir istekte bulundum.
ilginize çok teşekkür ederim.

 

[Failimechul]

Anlıyorum. Üzerinde çalışacağım

 

[kemal turan]

Çok teşekkür ederim.
Size ve İlgilenecek arkadaşlara minnettarım.
Selametle kalın

 

[kemal turan]

merhabalar,
Yapılmasını arzu ettiğim isteklerim dosyanın cari sahifesindedir.
Selametle kalın

 

[kemal turan]

Merhaba ustadlar,
Konu hakkında yardımlarınızı bekliyorum.İsteğimi dosyaya bakmadan açıklamak gerekirse ;
KOD1 de tahsilat miktarı girildiği zaman Tarih,Tahsilat,Satış Taksit, verileri girilen satırdaki istenilen hücrelere geliyor.
KOD2 ise gün sonunda iki tarih arası yapılan tahsilatlara ait verileri kasa sahifesine aktarıyor.
İsteğim bu işi KOD2 nin KOD 1 e eklenmesi ile her veri girişinde veri girilen satıra ait verileri kasa sahifesine aktarmak.
Yardımlarınızı bekliyorum.
Teşekkürler
.

KOD1
Private Sub Worksheet_Change(ByVal Target As Range)


On Error GoTo son
If Intersect(Target, [A2]) Is Nothing Then
On Error Resume Next
Sheets(CStr(Target.Value)).Select
End If
If Not Intersect(Target, [G:G]) Is Nothing Then

If Target.Value = "" Then
Target.Offset(0, 1) = ""
Target.Offset(0, 3) = ""
Target.Offset(0, 4) = ""
Else
If Target.Offset(0, 1) = "" Then Target.Offset(0, 1) = Date
If Target.Offset(0, 3) = "" Then Target.Offset(0, 3) = "TAHSİLAT"
If Target.Offset(0, 4) = "" Then Target.Offset(0, 4) = "SATIŞ-TAKSİT"
End If
End If
'AŞAĞIDAKİ AKTARMA KODUNUN BURAYA UYARLANMASI GEREKİYOR.'

son:

End Sub


KOD 2
Sub aktar()

Set s1 = Sheets("CARİ")
Set s2 = Sheets("KASA")
Range("a1").AutoFilter
Range("a1").AutoFilter Field:=8, Criteria1:=">=" & CLng(Range("o1").Value), _
Operator:=xlAnd, Field:=9, Criteria2:="<=" & CLng(Range("P1").Value)
m = MsgBox("KAYIT YAPILSIN MI.", vbYesNo, "AKSAY EV CONCEPT")
If m <> vbYes Then Exit Sub
Worksheets("KASA").AutoFilterMode = False
For i = 2 To s1.Range("A65536").End(3).Row
SONSTR = s2.Range("c65536").End(3).Row + 1
If s1.Cells(i, 1).EntireRow.Hidden = False Then

s2.Cells(SONSTR, 7).Value = s1.Cells(i, 2).Value
s2.Cells(SONSTR, 5).Value = s1.Cells(i, 4).Value
s2.Cells(SONSTR, 8).Value = s1.Cells(i, 7).Value
s2.Cells(SONSTR, 3).Value = s1.Cells(i, 8).Value
s2.Cells(SONSTR, 4).Value = s1.Cells(i, 10).Value
s2.Cells(SONSTR, 6).Value = s1.Cells(i, 11).Value

End If
Next
Sheets("kasa").Select
MsgBox "Kayıt işlemi tamamlanmıştır.", , "istikbal"



End Sub