Farklı sayfalardaki verileri bir sayfada toplama

[mrkync]

Arkadaşlar ektede belirttiğim gibi tümliste sayfasında ocak, şubat,mart,nisan mayıs, haziran,temmuz,ağustos,eylül,ekim, kasım ve aralık diye 12 adet sayfa var. Bu 12 adet sayfadaki veriler aynı tabloda ben ise tümliste de hepsini listelemek istiyorum. Bunu nasıl yapabilirim? Birde arkadaşlar aşağıdaki kodla ben sıralama yapıyordum ancak sıralamada bir satır fazla atıyor ve ben sıralamanın a2 den itibaren başlamasını istiyorum ve bir satır fazla atmasını istemiyorum bu kod üzerinde nasıl değişiklik yapabiliriz.

 For i = 1 To Range("d65530").End(3).Row
    On Error Resume Next
    If (Range("d" & i).Value <> "") Then
        Range("A" & i + 1) = i
    End If
 Next i

Çok teşekkürler

 

[Necdet]

Merhaba,

Aşağıdaki kodları dener misiniz?

Not : Tabloyu Aralığa dönüştürmedim. Bu yüzden 1 satır fazladan yazıyor.
Gerekirse tabloyu aralığa dönüştüren kodları da eklemek gerek.

Sub TumLuistedeBirlestir()
    
    Dim i   As Long, _
        j   As Long, _
        Syf As Integer, _
        ShT As Worksheet, _
        Dz()
        
    Dz = Array("Ocak", "Şubat", "Mart", "Nisan", "Mayıs", "Haziran", "Temmuz", "Ağustos", "Eylül", "Ekim", "Kasım", "Aralık")
    
    
    Set ShT = Sheets("Tumliste")
    Application.ScreenUpdating = False
    
    For Syf = 0 To UBound(Dz)
        j = Sheets(Dz(Syf)).Cells(Rows.Count, "A").End(3).Row
        i = ShT.Cells(Rows.Count, "A").End(3).Row + 1
        Sheets(Dz(Syf)).Range("A2:G" & j).Copy ShT.Range("A" & i)
    Next Syf
    
    With Application
        .ScreenUpdating = True
        .CutCopyMode = False
    End With
    
End Sub

 

[mrkync]

Necdet Bey şöyle bir sıkıntı oluştu benim excel sayfamda dediğim sayfaların dışında da sayfalar var o yüzden diğer sayfalardaki verileri de çekiyor bu seferde veriler karışıyor sadece benim dediğim sayfalardan verileri aldırabilir miyiz?

 

[apocalyt]

ilk 13 sayfa bu gönderdiğiniz dosyadaki gibiyse aşağıdakini deneyin..kolay gelsin..

Sub deneme()
Sheets(1).Range("a2:g100000").ClearContents
Z = 0
For x = 2 To 13
y = 2

For y = 2 To 1000
If Sheets(x).Cells(y, 4) <> "" Then

Sheets(1).Cells(Z + 2, 4) = Sheets(x).Cells(y, 4)
Sheets(1).Cells(Z + 2, 1) = Sheets(x).Cells(y, 1)
Sheets(1).Cells(Z + 2, 2) = Sheets(x).Cells(y, 2)
Sheets(1).Cells(Z + 2, 3) = Sheets(x).Cells(y, 3)
Sheets(1).Cells(Z + 2, 5) = Sheets(x).Cells(y, 5)
Sheets(1).Cells(Z + 2, 6) = Sheets(x).Cells(y, 6)
Sheets(1).Cells(Z + 2, 7) = Sheets(x).Cells(y, 7)
Z = Z + 1
Else
Exit For
End If
Next y
Next x

End Sub

 

[mrkync]

Apocalyt, acaba ilk 12 sayfa yerine benim dediğim sayfalardan verileri alsa olabilir mi? Yani Necdet beyin kodlarını sadece dediğim aralık şeklinde yapabilirsek işimi görür gibi geliyor. Nasıl yapabiliriz?

 

[mrkync]

Yardımlarınızı bekliyorum arkadaşlar

 

[apocalyt]

meraba..dosyanız ekte..eki inceleyin..makro kısmında yazan kodu kendi dosyanıza uygulayın..yanlız en üstte "option explicit" yazıyorsa silin..

 

[Necdet]

Merhaba,

2 nolu mesajımdaki kodları yeniledim.

 

[mrkync]

çok teşekkürler Necdet bey ve Apocalyt Harikasınız...