Farklı Sayfalardan Veri Çekmek

[vahapexcel]

Arkadaşlar örnek excel dosyası ektedir. Açıklama dosyanın içerisinde yazılmıştır.
Yardımlarınızı bekliyorum. Teşekkürler.

 

[Ömer]

Merhaba,

Bu şekilde deneyin. Para sayfasında fazlalık satır ve sütunu sildim, ayrıca birleştirilmiş hücreleri de kaldırdım. Gerek duymadıkça kullanmamaya özen göstermenizi tavsiye ederim.

Sub Ozet()
 
    Dim dizi(), syf As Worksheet, j As Byte, i As Byte, son As Long, sat As Long
    Application.ScreenUpdating = False
    
    Sheets("Para").Select
    Range("A2:C" & Rows.Count).Clear
    Cells.RemoveSubtotal
    
    dizi = Array("", "ABC", "A", "B", "C")
    For j = 1 To 67 Step 6
        For i = 1 To 4
            Set syf = Sheets(dizi(i))
            With syf
                son = .Cells(Rows.Count, j).End(xlUp).Row
                If son <> 3 Then
                    sat = Cells(Rows.Count, "B").End(xlUp).Row + 1
                    Range(Cells(sat, "A"), Cells(sat + son - 4, "A")) = Format(CDate("1." & .Cells(1, j)), "mmmm")
                    .Range(.Cells(4, j), .Cells(son, j + 1)).Copy Cells(sat, "B")
                End If
            End With
        Next i
    Next j
    
    Range("A1:C" & sat).Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
        
    Columns("A:C").EntireColumn.AutoFit
    Application.ScreenUpdating = True
    
End Sub

Dosyanız ektedir.

.

 

[vahapexcel]

Ömer Bey Emeğiniz ve çabanız teşekkür ederim.

Bir değişiklik yapabilirmiyiz.

Biçimlendirme ile birlikte aktarım yapıyor.
mevcut hücre biçimlendirme ne ise olduğu şekilde muhafa edilmesi sadece değerlerin aktarılması mümkün mü?
değil ise çok sorun değil

 

[Ömer]

Ömer Bey Emeğiniz ve çabanız teşekkür ederim.

Bir değişiklik yapabilirmiyiz.

Biçimlendirme ile birlikte aktarım yapıyor.
mevcut hücre biçimlendirme ne ise olduğu şekilde muhafa edilmesi sadece değerlerin aktarılması mümkün mü?
değil ise çok sorun değil

Kodları aşağıdakilerle değiştirin.

Sub Ozet()
 
    Dim dizi(), syf As Worksheet, j As Byte, i As Byte, son As Long, sat As Long
    Application.ScreenUpdating = False
 
    Sheets("Para").Select
    Range("A2:C" & Rows.Count).Clear
    Cells.RemoveSubtotal
 
    dizi = Array("", "ABC", "A", "B", "C")
    For j = 1 To 67 Step 6
        For i = 1 To 4
            Set syf = Sheets(dizi(i))
            With syf
                son = .Cells(Rows.Count, j).End(xlUp).Row
                If son <> 3 Then
                    sat = Cells(Rows.Count, "B").End(xlUp).Row + 1
                    Range(Cells(sat, "A"), Cells(sat + son - 4, "A")) = Format(CDate("1." & .Cells(1, j)), "mmmm")
                    .Range(.Cells(4, j), .Cells(son, j + 1)).Copy
                    Cells(sat, "B").PasteSpecial xlPasteValues, xlNone
                End If
            End With
        Next i
    Next j
[COLOR=red] [/COLOR]
[COLOR=red]    Range("A1:C" & sat).Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3), _[/COLOR]
[COLOR=red]        Replace:=True, PageBreaks:=False, SummaryBelowData:=True[/COLOR]
 
    Columns("A:C").EntireColumn.AutoFit
    Application.ScreenUpdating = True
 
End Sub

.

 

[vahapexcel]

ömer bey merhaba
makroda bir değişklik daha yapabilirmiyiz
size zahmet
satır ekleme ve ayların toplamını yapmasın

 

[Ömer]

#4 numaralı mesajda kırmız işaretlediğim kodları siler yada önüne tek tırnak işareti koyarsanız istediğiniz olur.

 

[vahapexcel]

teşekkürler ömer bey

 

[vahapexcel]

teşekkürler ömer bey;

Bir talepte daha bulunabilirmiyiz.

bu çalıma dosyası 17 sayfalı bir çaılma olduğu için makroyu çalıştırınca farklı durumlar olabiliyor. Bu nedenle parça parça taleplerde bulunuyorum. Kusura kalmayın.

Para sayfasına aktarım yapılan her ay için sabit satırlar verebilirmiyiz. Yani
Ocak ayı için A4:C24
Şubat ayı için A25:C45
.....
yani her ayın 20 satır aralığına yerleşmesi aşağı kısımlar boş kalsada sorun teşkil etmiyor.
Örnek ektedir.
Başka katkılarınız da olursa sevinirim.

 

[vahapexcel]

ömer bey katkılarınızı bekliyorum