Sayfa1 tablolardan, Sayfa2 tabloya veri çekme

[EKREM1661]

Değerli üstadlarım..! Ekli dosyada; Sayfa1 de alta alta sıralı (20 satır ara ile) 12 ay'a ait tablolar var.. Bu tablolardan istediğim bir tablonun bilgilerini, Sayfa2 deki tabloya çekmek istiyorum..

Böyle bir uygulama yapabilir miyiz.? Formüllerle bir çıkış yolu bulamadım. Sayfa üzeri combobox ktusu üzerinde düşündüm..

 

[YUSUF44]

Ekli dosyayı inceleyiniz:

https://drive.google.com/file/d/0B43WMUs21VpfS3owM3gxTkt4dmM/view?usp=sharing

 

[EKREM1661]

Saygıdeğer Yusuf hocam..! Elinize ve bilginize sağlık, çok teşekkür ediyorum ve ziyadesiyle memnun oldum.. Son olarak sizler bu işe el atmışken, şöyle bir şey de yapılabilir mi?.. Yıl sonunda, her ay'a ait tablolardan, bir başka tabloya döküm alınıyor.. Fakat, aradaki boş satırları yok saydırarak alt alta sıralı olarak bu işi yaptırabilir miyiz.? Kolay anlaşılması için ekli örneği kırparak ekledim..

 

[YUSUF44]

Aşağıdaki kodları Yıllık toplam için kullanabilirsiniz. Bu kodun doğru çalışabilmesi için ilk sayfada AT sütunundaki başlıkların (Tutarı TL) dolu olması gerekmektedir:

Sub yıllık()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Yıllık Döküm")
For i = 7 To s1.Cells(Rows.Count, "AT").End(3).Row Step 20
    If s1.Cells(i, "AJ") <> "" Then
        yeni = WorksheetFunction.Max(8, s2.Cells(Rows.Count, "C").End(3).Row + 1)
        liste = s1.Cells(i - 1, "AT").End(xlDown).Row
        s1.Range(s1.Cells(i, "AJ"), s1.Cells(liste, "AT")).Copy s2.Cells(yeni, "C")
    End If
Next
For j = 8 To s2.Cells(Rows.Count, "C").End(3).Row
    s2.Cells(j, "B") = "Cinsixxx" & j - 7
Next
End Sub

 

[EKREM1661]

Saygıdeğer Yusuf hocam..! Size özellikle teşekkür ettikten sonra, tekrar size müracaat etmek zorunda kaldım.. Örneklerinizi çalışmalarıma uyarladım, ancak makro kodunda kalan 5 sütun için kendim uyarlamaya çalıştım, fakat doğru sonuç alamadım.. Ekli dosyayı sadeleştirerek açıklamasını yazdım.. Tekrar bakabilirseniz, çok makbule geçecek..

 

[YUSUF44]

YıllıkDöküm isimli makro kodlarını aşağıdakiyle değiştirip deneyiniz:

Sub YıllıkDöküm()
Set s1 = Sheets("girdi")
Set s2 = Sheets("Yıllık Döküm")

For i = 7 To s1.Cells(Rows.Count, "AT").End(3).Row Step 20
    If s1.Cells(i, "AJ") <> "" Then
        yeni = WorksheetFunction.Max(8, s2.Cells(Rows.Count, "G").End(3).Row + 1)
        liste = s1.Cells(i - 1, "AT").End(xlDown).Row
        s1.Range(s1.Cells(i, "AJ"), s1.Cells(liste, "AT")).Copy s2.Cells(yeni, "G")
        s1.Range(s1.Cells(i, "D"), s1.Cells(liste, "E")).Copy s2.Cells(yeni, "B")
        s1.Range(s1.Cells(i, "J"), s1.Cells(liste, "J")).Copy s2.Cells(yeni, "D")
        s1.Range(s1.Cells(i, "M"), s1.Cells(liste, "M")).Copy s2.Cells(yeni, "E")
        s1.Range(s1.Cells(i, "I"), s1.Cells(liste, "I")).Copy s2.Cells(yeni, "F")
    End If
Next

End Sub

 

[EKREM1661]

Yusuf bey, harikasınız.. Elinize sağlık.. Ziyadesiyle teşekkür ederim ve hayırlı ömürler dilerim..

 

[EKREM1661]

Yusuf bey, merhaba.. Sizin formüllerinizi bir başka tabloya uyarlamak takıldığım noktayı arzettim. Ekli dosyaya bakabilirseniz, sorunu ifade ettim..

 

[YUSUF44]

SATIR()-1 yerine SATIR()+1 kullanın.