Her ayki sabit giderleri otomatik hesaplatabilirmiyiz?

[asildayi]

Herkese iyi gunler,
Benim sorum excelde yapmis oldugum banka takip sayfasinda 2.sayfaya yazmis oldugum sabit giderlerimin gunu geldiginde otomatik olarak 1. sayfadaki tabloya aktarilip aktarilamayacagi.

Yani tam olarak excel sayfamizi actigimizda bu gunun tarihini otomatik olarak algilayip banka sayfasinin siradaki tarih satirina yeni tarihli giris yaparak sabit giderler sayfasindaki ayin 5'indeki B ve C kolonlarindaki degerleri banka sayfasindaki D ve E kolanlarina girebilirmi?

Ornek dosyayi asagida yolluyorum.
Simdiden tesekkurler;

 

[Orion1]

Bence butonla yapın.
İstediğiniz zaman listeyi çıkarabilirsiniz.Ve istediğiniz tarihi çıkarabilirsiniz.
Unutmayın kontrol her zaman sizde olmalı.
Aksi durumlar iyi sonuç vermez.Yani ben kişisel olarak tercih etmem.
Ne olacak yani bir buton koyarım.Tıklayıverirrim,çokmu zor.Sonra bir kaç gün gelmediniz diyelim exceli açmadınız sonra açtınız .Ne olacak öncekiler.Yani en iyisi kontrolu daima elde tutmakta fayda var.Böyle şeylere özenmemek daha doğru olur.
Kolay gelsin

 

[asildayi]

Evet bir bakima haklisiniz evren bey buton ilginç bir fikir.
Deniyecegim fakat, bana buton konusunda daha detayli yardimci olabilirmisiniz gonderdigim ornek dosya uzerinde.

 

[Orion1]

Evet bir bakima haklisiniz evren bey buton ilginç bir fikir.
Deniyecegim fakat, bana buton konusunda daha detayli yardimci olabilirmisiniz gonderdigim ornek dosya uzerinde.

2nci sayfada tarih alanına formüller girdim.O sütun o düzenlediğim biçimde olmalıdır.
Dosyanız ektedir.

Sub aktar()
Dim k As Range, adr As String, sat1 As Long, sat2 As Long
Dim sh2 As Worksheet
Sheets("banka").Select
Range("A1").AutoFilter
Set sh2 = Sheets("sabit giderler")
sat2 = sh2.Cells(65536, "B").End(xlUp).Row
If sat2 < 2 Then
    MsgBox "Aktarılacak veri bulunamadı.", vbCritical, "UYARI"
    Exit Sub
End If
sat1 = Cells(65536, "D").End(xlUp).Row + 1
Application.ScreenUpdating = False
Set k = sh2.Range("A2:A" & sat2).Find(Date, , xlValues, xlWhole)
If Not k Is Nothing Then
    adr = k.Address
    Do
        If sat1 >= 65533 Then
            Range("D" & sat1).Select
            MsgBox "Satır doldu.Diğer kayıtlar aktarılmadı.", vbCritical, "UYARI"
            If ActiveSheet.AutoFilterMode = False Then Range("A1").AutoFilter
            Application.ScreenUpdating = True
            Exit Sub
        End If
        Cells(sat1, "B").Value = k.Value
        Cells(sat1, "D").Value = k.Offset(0, 1).Value
        Cells(sat1, "E").Value = k.Offset(0, 2).Value
        sat1 = sat1 + 1
        Set k = sh2.Range("A2:A" & sat2).FindNext(k)
    Loop While Not k Is Nothing And k.Address <> adr
    If ActiveSheet.AutoFilterMode = False Then Range("A1").AutoFilter
    Range("D" & sat1).Select
    Application.ScreenUpdating = True
    MsgBox "Bu günkü Kayıtlar aktarıldı" & vbLf & _
    "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End If
If ActiveSheet.AutoFilterMode = False Then Range("A1").AutoFilter
Application.ScreenUpdating = True

End Sub

 

[asildayi]

Cok tesekkurler, gerçekdende daha kullanisli;
Ben eski tarihli kayitlara donemedim sadece hep bu gunun kayitlarini giriyor.
Kaldiki eski tarihli kayitlari zamaninda girmeyince takilma olacak ki bu isleri ve sanirim formulude baya karistiracak.

Ben tarihleri iki tarihe sabitleyip (her ayin 6 si ve 15 i) sabit gider sayfasini ikiye çikarip denedim gayet guzel calisiyor tek sorunum tarihi otomatik bu gunun tarihi atmasi.
Tarihi ilk sayfada ayin 6 si 2. sayfada ise 15 i olarak sabitlemek ve bu sekilde banka sayfasina aktarmak istedim ama olmadi.
tabi sebep ortada sizin yazmis oldugunuz 2. sayfadaki tarih formullerini silmem ki sabit tarihe dönmek istedigim için mecbur kaldim.
Birde sabit gider sayfasina yeni bir kolon ekledim islem turu bilgisi için. Ornek dosyayi tekrar gonderiyorum bir daha goz atabilirmisiniz lutfen?

 

[Orion1]

Dosyanız ektedir.

Sub aktarim()
Dim k As Range, adr As String, sat1 As Long, sat2 As Long
Dim sh2 As Worksheet, i As Long
Sheets("banka").Select
Range("A1").AutoFilter
Set sh2 = Sheets("sabit giderler")
sat2 = sh2.Cells(65536, "C").End(xlUp).Row
If sat2 < 2 Then
    MsgBox "Aktarılacak veri bulunamadı.", vbCritical, "UYARI"
    Exit Sub
End If
sat1 = Cells(65536, "D").End(xlUp).Row + 1
Application.ScreenUpdating = False
    For i = 2 To sat2
        If sat1 >= 65533 Then
            Range("D" & sat1).Select
            MsgBox "Satır doldu.Diğer kayıtlar aktarılmadı.", vbCritical, "UYARI"
            If ActiveSheet.AutoFilterMode = False Then Range("A1").AutoFilter
            Application.ScreenUpdating = True
            Exit Sub
        End If
        Cells(sat1, "B").Value = sh2.Cells(i, "A").Value
        Cells(sat1, "C").Value = sh2.Cells(i, "A").Value
        Cells(sat1, "D").Value = sh2.Cells(i, "C").Value
        Cells(sat1, "E").Value = sh2.Cells(i, "D").Value
        sat1 = sat1 + 1
    Next i
    If ActiveSheet.AutoFilterMode = False Then Range("A1").AutoFilter
    Range("D" & sat1).Select
    Application.ScreenUpdating = True
    MsgBox "Bu günkü Kayıtlar aktarıldı" & vbLf & _
    "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
If ActiveSheet.AutoFilterMode = False Then Range("A1").AutoFilter
Application.ScreenUpdating = True

End Sub

 

[asildayi]

Evet tam olarak budur evren bey bir kez daha yardimlariniz için tesekkurler.
Ikinci bir tesekkurde beni buton olayina yonlendirdiginiz için. Gerçekdende haklisiniz kontrolun bizde olmasi gibisi yok

 

[Orion1]

Evet tam olarak budur evren bey bir kez daha yardimlariniz için tesekkurler.
Ikinci bir tesekkurde beni buton olayina yonlendirdiginiz için. Gerçekdende haklisiniz kontrolun bizde olmasi gibisi yok

Rica ederim.
İyi çalışmalar.