Aktar Makrosuna İlave

[1Al2Ver]

Merhaba,

"Günlük" sayfasında yeni bir sütun açtım (AC4:AC30)

"Günlük" sayfasındaki mevcut AKTAR butonu tıklandığında;

Yapmakta olduğu işlemin yanı sıra, AC4:AC30 aralığını,

"Aylık" sayfasında AI4:AI30 aralığına aktarsın ve her aktarıldığında da AI4:AI30 da üst üste toplasın, istiyorum,

Makro şu haliyle buna imkan vermiyor, aynı buton ile 2 işlemi aynı anda yapabilmek için gereken makroyu rica ediyorum.

Teşekkür ederim.

 

[ozgretmen]

Her aktarıldığında da AI4:AI30 da üst üste toplasın

Zaten AI31 de toplanıyor.

s2.Cells(k.Row, s2_tr.Column).Value = s1.Cells(i, "AA").Value

Bu kodun altına aşağıdakini ekle...

s2.Cells(k.Row, 35).Value = s1.Cells(i, "AC").Value

 

[1Al2Ver]

Zaten AI31 de toplanıyor.

s2.Cells(k.Row, s2_tr.Column).Value = s1.Cells(i, "AA").Value

Bu kodun altına aşağıdakini ekle...

s2.Cells(k.Row, 35).Value = s1.Cells(i, "AC").Value

Sayın ozgretmen, merhaba

İlginiz için teşekkür ederim, ancak ;

Günlük sayfasından B1 deki tarihe (22.01.2009) göre, aylık sayfasındaki tarihe (22.01.2009) veri aktarılıyor, bu işlem gerçekleşirken, günlük sayfası AC4:AC30 da aylık sayfası AI4:AI30 aralığına aktarılıyor, buraya kadar sorun yok,

Sorun, tarihe göre her aktarma esnasında aylık sayfasına aktarılan AI4:AI30 aralığındaki rakamlar, bir öncekiler ile toplanmalı, örneğin; 21.09.2009 da aktarılan sayılara göre AI4= 5 iken 22.09.2009 tarihinde aktarılan 10 ise AI4 te görünmesi gereken sayı 15 olmalı

Sizi de yoruyorum ama, artık kusuruma bakmayın, tekrar teşekkür ederim.

 

[ozgretmen]

Aşağıdaki şekilde dener misin ?

Sub aktar()
Sheets("Günlük").Select
If MsgBox("Verileri Aylık sayfasına aktarmak istiyormusunuz?", vbYesNo + vbQuestion, "DİKKAT") = vbNo Then Exit Sub
Set s1 = Sheets("Günlük")
Set s2 = Sheets("Aylık")
Application.ScreenUpdating = False
If Range("B1").Value = "" Then Exit Sub
s1_son_sat = Cells(65536, "B").End(xlUp).Row - 1
s1_tarih = Range("B1").Value
For i = 4 To s1_son_sat
    Set s2_tr = s2.Range("C2:IV2").Find(s1_tarih, , xlValues, xlWhole)
    If Not s2_tr Is Nothing Then
        Set k = Range("B4:B65536").Find(s1.Cells(i, "B").Value, , xlValues, xlWhole)
        If Not k Is Nothing Then
            s2.Cells(k.Row, s2_tr.Column).Value = s1.Cells(i, "AA").Value 'S
            s2.Cells(k.Row, 35).Value = Val(s2.Cells(k.Row, 35).Value) + Val(s1.Cells(i, "AC").Value)
        End If
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı..!!", vbOKOnly + vbInformation, "KAYIT"
End Sub

 

[1Al2Ver]

Sayın ozgretmen merhaba,

Çok teşekkür ederim, projenin en önemli bölümü sayenizde tamamlandı, sağolun,

Bu yardımseverliğiniz için kişisel kanaatimi ifade etmek istiyorum, uzman olma yolunda emin adımlarla ilerliyorsunuz, yakın bir gelecekte sizi uzman göreceğime eminim, bu benim şahsi görüşüm, yönetimdeki arkadaşlarımız lütfen bunu yanlış anlamasınlar, sadece hissettiklerimi paylaşmak istedim, tekar teşekkür ederim.

Saygılarımla.

 

[ozgretmen]

Sayın ozgretmen merhaba,
Çok teşekkür ederim, projenin en önemli bölümü sayenizde tamamlandı, sağolun,
Bu yardımseverliğiniz için kişisel kanaatimi ifade etmek istiyorum, uzman olma yolunda emin adımlarla ilerliyorsunuz, yakın bir gelecekte sizi uzman göreceğime eminim, bu benim şahsi görüşüm, yönetimdeki arkadaşlarımız lütfen bunu yanlış anlamasınlar, sadece hissettiklerimi paylaşmak istedim, tekar teşekkür ederim.
Saygılarımla.

Uzman olmak gibi bir amacım yok...Sadece paylaşmak ve paylaşırken de öğrenmek...Ve bir teşekkür almak o kadar güzel bir duygu ki ...İyi çalışmalar dilerim...

 

[1Al2Ver]

Uzman olmak gibi bir amacım yok...Sadece paylaşmak ve paylaşırken de öğrenmek...Ve bir teşekkür almak o kadar güzel bir duygu ki ...İyi çalışmalar dilerim...

Sayın ozgretmen merhaba,

Elbetteki böyle bir amacınız olmayabilir, ben duygularımı paylaştım, buna layık olduğunuzu düşünen ve hisseden biriyim, zaten bundan sonrası ilgililerin ve sizin inisiyatifinizde,

İyi akşamlar dilerim, saygılarımla.

 

[ozgretmen]

Size de iyi akşamlar...:hey: