• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Sayfa1 tablolardan, Sayfa2 tabloya veri çekme

Katılım
10 Kasım 2006
Mesajlar
1,288
Excel Vers. ve Dili
Excel-2016
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..
 

Ekli dosyalar

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..
 

Ekli dosyalar

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:

Kod:
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
 
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..
 

Ekli dosyalar

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

Kod:
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
 
Yusuf bey, harikasınız.. Elinize sağlık.. Ziyadesiyle teşekkür ederim ve hayırlı ömürler dilerim..
 
Yusuf bey, merhaba.. Sizin formüllerinizi bir başka tabloya uyarlamak takıldığım noktayı arzettim. Ekli dosyaya bakabilirseniz, sorunu ifade ettim..
 

Ekli dosyalar

SATIR()-1 yerine SATIR()+1 kullanın.
 
Geri
Üst