Tablodan Veri çekme

[sahika51]

Saygıdeğer arkadaşlar. Ekli programda yeni bir tablo oluşturmam gerekiyor. Yardımcı olursanız sevinirim.
D Sütununda ürünler var bu ürünler tekrarsız olarak L sütununa listelenmesi gerekiyor. Tabi D sütununa yeni bir ürün eklediğimde de ürün L sütununa eklenmeli
G sütununda ürünlerin toplamları var. Bunların toplamı M sütununa. Örnek verecek olursak 4 ayrı yerde KRİSPİ var. Bir Kere KRİSPİ ve toplamı 255 olması gerekir.
M3 ten N3 çıkartılacak ve O3 e yazılacak.
Program açıldığında çalışırsa güzel olur

 

[sahika51]

Sub listele()
Dim S1 As Worksheet: Set S1 = Sheets("Sayfa1")
Dim S2 As Worksheet: Set S2 = Sheets("Stok")

Application.ScreenUpdating = False
son = S1.Cells(Rows.Count, 4).End(xlUp).Row
S2.Range("b3:b" & S2.Cells(Rows.Count, 2).End(xlUp).Row).ClearContents
sat = 2
For i = 3 To son
If WorksheetFunction.CountIf(S2.Range("b3:b" & i), S1.Cells(i, "d")) < 1 Then
sat = sat + 1
toplam = WorksheetFunction.SumIf(S1.Range("D3:d" & son), S1.Cells(i, 4), S1.Range("G3:G" & son))
S2.Cells(sat, 1).Resize(1, 3) = Array(sat - 2, S1.Cells(i, "d"), toplam)
End If
Next
Application.ScreenUpdating = True
End Sub


Böyle bir kod var ama ben bunu aynı sayfa için uyarlayamadım. Emojinin karşılığı Yardım