Sekmeler arası veri aktarımında verinin sıradaki satıra girilmesi

[majesteleri]

Selamlar..

Arkadaşlar makro yazmayı hiç mi hiç bilmiyordum fakat henüz kimseye bir şey sormadan kısa bir sürede bu forumdan okuyarak kendi çapımda birşeyler öğrendim ve basitte olsa ihtiyacım olan programı yazmaya başladım..Fakat sanırım sormanın sırası geldi Ekte bulabileceğiniz programda amacım: Günlük Kasa Raporu isimli sayfaya yazılan bilgiler B,C,D sütunlarındaki kodlarına göre ilgili sekmeye aktarılması ve düzgün bir şekilde aktarıldıktan sonra Günlük Kasa Raporu sayfasının o günün tarihiyle beraber ayrı bir sekme (sekme adı o günün tarihi olacak) olarak kaydedilmesi ve bundan sonra Günlük Kasa Raporu isimli sekmedeki bilgilerin silinerek temiz bir rapor sayfası olarak kalması .. İlgili sekmeye aktarma kısmını hallettim fakat bilgileri bir türlü sıradaki satıra yazdıramıyorum ..

Biraz karışık anlatmış olabilirim Ekteki dosyada daha ayrıntılı açıklama yaptım..Yardımcı olabilirseniz sevinirim..

Saygılar ...

 

[majesteleri]

Beyler 30 kişi okumuş .. Hiç cevap yok mu ?? Yardım lütfen ..

 

[fedeal]

Sub fdl()
Dim i, f As Integer
Dim sf As Worksheet
For i = 14 To 37
If Worksheets("Günlük Kasa Raporu").Cells(i, 4).Value = "" Then GoTo son
Set sf = Sheets(Worksheets("Günlük Kasa Raporu").Cells(i, 4).Value)
son = sf.Range("b65000").End(xlUp).Row + 1
For f = 1 To 16
sf.Cells(son, f).Value = Worksheets("Günlük Kasa Raporu").Cells(i, f).Value
Next
Next
son:
    Sheets("Günlük Kasa Raporu").Select
    Sheets("Günlük Kasa Raporu").Copy After:=Sheets(3)
    Sheets("Günlük Kasa Raporu (2)").Select
    Sheets("Günlük Kasa Raporu (2)").Name = now
    Sheets("Günlük Kasa Raporu").Range("A14:p37").ClearContents
End Sub

kodları deneyin umarım istediginiz gibi olmuştur.iyi çalışmalar.

 

[majesteleri]

Sub fdl()
Dim i, f As Integer
Dim sf As Worksheet
For i = 14 To 37
If Worksheets("Günlük Kasa Raporu").Cells(i, 4).Value = "" Then GoTo son
Set sf = Sheets(Worksheets("Günlük Kasa Raporu").Cells(i, 4).Value)
son = sf.Range("b65000").End(xlUp).Row + 1
For f = 1 To 16
sf.Cells(son, f).Value = Worksheets("Günlük Kasa Raporu").Cells(i, f).Value
Next
Next
son:
    Sheets("Günlük Kasa Raporu").Select
    Sheets("Günlük Kasa Raporu").Copy After:=Sheets(3)
    Sheets("Günlük Kasa Raporu (2)").Select
    Sheets("Günlük Kasa Raporu (2)").Name = now
    Sheets("Günlük Kasa Raporu").Range("A14:p37").ClearContents
End Sub

kodları deneyin umarım istediginiz gibi olmuştur.iyi çalışmalar.

Çok çok teşekkür ederim.. Tam istediğim gibi olmuş.. Elinize sağlık

 

[majesteleri]

Bir sorum daha olacak.. Yukarıdaki formül işe yarıyor fakat bir problemi var ..Veriler Demir ve Kereste sayfalarına yazılması gereken yerden 3 satır yukarıya yazılıyor..Bunların 3 satır aşağıya yazılmasını sağlayamıyorum..

Şu satıra göre ;

son = sf.Range("b65000").End(xlUp).Row + 1

veriler 7. satıra yazılmaya başlıyor..Oysa 10. satırdan başlanmalı.. Açıkcası yukarıdaki satırın tam anlamanı anlayamadığım için 10. satırdan başlayacak şekilde formülü revize edemedim..

Yardımcı olursanız sevinirim..

 

[fedeal]

o satırın anlamı sayfanın b sütunun son dolu hücresi +1 yani ilk boş hücresi son dolu hücre bsütunda 6.satırdaysa 7ye yazacaktır eğer b9 a bir sey girerseniz b10 yazacaktır.

 

[majesteleri]

anlaşıldı teşekkürler tekrar Bu sefer gerçekten oldu