bir çalışma sayfasındaki verileri tarihe göre başka bir sayfaya yazması

[olymposss]

saygıdeğer ustadlarım,
tekrar yardımınıza ihtiyacım var.

istediğim şey ise;

"sayfa1" de tarihleri verilmiş birkaç veri var. "10.ay" ve "11.ay" diye 2 tane sayfa daha var. istediğim kitap çalışmaya başladığı zaman sayfa1 deki verileri 10. ve 11. ay olarak ayırması ve ilgili sayfalara listelemesi. her çalıştığında bunu tekrar yapması. çünkü her gün sayfa1 e yeni veriler eklenecek.
dosya ektedir.

şimdiden teşekkürler. saygılar:yardim:

----------------------------------------------------------------------------
bana bir harf öğretenin KIRK yıl kölesi olurum.

 

[Orion1]

Merhabalar.
Ekli dosyayı incelermisiniz.
Sayfa1 den çıkınca verileri ilgili tarihli sayfalara yazıyor.

 

[olymposss]

Sn Sezar

ilginize çok teşekkürler

ancak diğer sayfayı seçince "subscript out of range" hatası veriyor.
bunu sayfa açılınca hepsini düzeltmesi gibi veya başka bir yöntemle yapabilirmiyiz.
teşekkürler saygılar:yardim:

 

[Levent Menteşoğlu]

Aşağıdaki kodları bir normal modüle kopyalayın. Her ikiside dosyayı her açışınızda çalışacaktır.

Eğer her seferinde sadece son eklenen verileri kaydedecekseniz aşağıdaki kodu kullanabilirsiniz. Bu durumda verilerin yeri asla değiştirilmemelidir.

Sub auto_open()
Set s1 = Sheets("sayfa1")
sor = MsgBox("Veriler sayfalara aktarılsınmı?", vbYesNo)
If sor = vbNo Then Exit Sub
ilk = WorksheetFunction.CountA(Sheets("10.AY").[a:a]) + WorksheetFunction.CountA(Sheets("11.AY").[a:a]) + 1
For a = ilk To s1.[a65536].End(3).Row
deg = Month(s1.Cells(a, "b"))
Set s2 = Sheets(deg & ".AY")
say = WorksheetFunction.CountA(s2.[a:a]) + 1
s2.Cells(say, "a") = s1.Cells(a, "a")
s2.Cells(say, "b") = s1.Cells(a, "b")
Next
End Sub

Eğer her seferinde tamamını aktarsın istiyorsanız aşağıdaki kodu kullanabilirsiniz.

Sub auto_open()
Set s1 = Sheets("sayfa1")
sor = MsgBox("Veriler sayfalara aktarılsınmı?", vbYesNo)
If sor = vbNo Then Exit Sub
Sheets("10.AY").[a:b].ClearContents
Sheets("11.AY").[a:b].ClearContents
For a = 1 To s1.[a65536].End(3).Row
deg = Month(s1.Cells(a, "b"))
Set s2 = Sheets(deg & ".AY")
say = WorksheetFunction.CountA(s2.[a:a]) + 1
s2.Cells(say, "a") = s1.Cells(a, "a")
s2.Cells(say, "b") = s1.Cells(a, "b")
Next
End Sub

 

[olymposss]

mükemmel mükemmel mükemmel

fazla söze gerek yok hocam. elinize sağlık.
ayrıca bu ortamı sağladıkları içinde teşekkür ederim.:hihoho:

 

[Orion1]

ilginize çok teşekkürler

ancak diğer sayfayı seçince "subscript out of range" hatası veriyor.
bunu sayfa açılınca hepsini düzeltmesi gibi veya başka bir yöntemle yapabilirmiyiz.
teşekkürler saygılar:yardim:

Merhaba
Bende hata vermiyor.
Yeni veri girdiyseniz ve 10ncu ve 11nci ay dışında tarih girdiyseniz.
Veya tarihi yanlış girdiyseniz o sbepten hata veriyordur.
Eğer 10ncu ve 11nci ayların dışındada tarih girecekseniz o na ait sayfa ekleyiniz.
ve For i = 2 To 3 yerine For i = 2 To Worksheets.Count kodunu koyunuz.ve deneyiniz.
Şu sebepten oluyordur.mesela Ocak ayını 01.AY diye çalışma sayfası olarak eklemediniz,ve adlandırmadınız.
1.AY diye isimlendirdiniz.O sebepten büyük ihtimalle hata veriyor.