Soru Birden Fazla Getiri Sütununu Tek Sütunda Birleştirme

[optimo]

Merhaba dosyadaki tüm sayfalarda A sütununda eşleşen tarihlerin karşılığındaki E sütununu toplamak istiyorum, tarihleri eşlenmeyenleri nasıl dahil ediceğimi örnek olması için sepet diye bir sayfa yaptım fakat orada 2 sayfayı yapabildim belki de yapamadım, sonrasına kafam karıştı. Aslında seçenekli yapma imkanı varsa mesela seçtiğimiz sayfaları birleştirsin gibi genel dinamik bir yapı olabilirse çok daha iyi olabilir. Yardımlarınızı bekliyorum.

portfolio.xlsx - 298 KB

 

[YUSUF44]

Çok anlamadım ancak linkteki dosya gibi bir çözüm mü istiyorsunuz?

hisse karşılaştırma.xlsm

drive.google.com

 

[optimo]

Çok anlamadım ancak linkteki dosya gibi bir çözüm mü istiyorsunuz?

hisse karşılaştırma.xlsm

drive.google.com

elinize sağlık tam olarak istediğim buydu fakat mesela yeni bir sayfa oluşturdum aktar dedim o yeni sayfa sepet sayfasında gelmedi neden acaba

 

[YUSUF44]

Öyle bir şey istemediğinizden olabilir mi acaba

Dosyadaki Hisseler makrosunu aşağıdakiyle değiştirin:

Sub hisseler()
Set s1 = Sheets("SEPET")
Application.ScreenUpdating = False
For i = 1 To Sheets.Count
    If Sheets(i).Name <> "SEPET" Then
        son = Sheets(i).Cells(Rows.Count, "A").End(3).Row
        If son > 1 Then
            eski = s1.Cells(Rows.Count, "A").End(3).Row
            sonsut = s1.Cells(1, Columns.Count).End(xlToLeft).Column
            If WorksheetFunction.CountIf(s1.Range(Cells(1, "A"), Cells(1, sonsut)), Sheets(i).Name) = 0 Then
                s1.Cells(1, sonsut + 1) = Sheets(i).Name
                For j = 2 To son
                    If Sheets(i).Cells(j, "G") <> "Tamam" Then
                        If WorksheetFunction.CountIf(s1.Range("A1:A" & eski), Sheets(i).Cells(j, "A")) = 0 Then
                            s1.Cells(eski + 1, "A") = Sheets(i).Cells(j, "A")
                            s1.Cells(eski + 1, sonsut + 1) = Sheets(i).Cells(j, "E")
                            s1.Cells(eski + 1, "B").FormulaR1C1 = "=SUM(RC[1]:RC[" & sonsut - 1 & "])"
                        Else
                            sat = WorksheetFunction.Match(Sheets(i).Cells(j, "A"), s1.Range("A1:A" & eski), 0)
                            s1.Cells(sat, sonsut + 1) = Sheets(i).Cells(j, "E")
                            s1.Cells(sat, "B").FormulaR1C1 = "=SUM(RC[1]:RC[" & sonsut - 1 & "])"
                        End If
                        Sheets(i).Cells(j, "G") = "Tamam"
                    End If
                Next
            Else
                sut = WorksheetFunction.Match(Sheets(i).Name, s1.Range(Cells(1, "A"), Cells(1, sonsut)), 0)
                For j = 2 To son
                    If Sheets(i).Cells(j, "G") <> "Tamam" Then
                        If WorksheetFunction.CountIf(s1.Range("A1:A" & eski), Sheets(i).Cells(j, "A")) = 0 Then
                            s1.Cells(eski + 1, "A") = Sheets(i).Cells(j, "A")
                            s1.Cells(eski + 1, sut) = Sheets(i).Cells(j, "E")
                            s1.Cells(eski + 1, "B").FormulaR1C1 = "=SUM(RC[1]:RC[" & sonsut - 1 & "])"
                        Else
                            sat = WorksheetFunction.Match(Sheets(i).Cells(j, "A"), s1.Range("A1:A" & eski), 0)
                            s1.Cells(sat, sut) = Sheets(i).Cells(j, "E")
                            s1.Cells(sat, "B").FormulaR1C1 = "=SUM(RC[1]:RC[" & sonsut - 1 & "])"
                        End If
                        Sheets(i).Cells(j, "G") = "Tamam"
                    End If
                Next
            End If
        End If
    End If
Next
s1.Range("A1:A" & eski).NumberFormat = "dd/mm/yyyy"
s1.Range(Cells(2, "B"), Cells(eski, sonsut)).NumberFormat = "#,##0.00"


Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı", vbExclamation
End Sub

 

[optimo]

çok teşekkürler sorunum çözülmüştür konu kapanabilir