Aynı olanların toplamlarını alsın

[fdisk]

Arkadaşlar örnek dosyada
sayfa 1 deki verilirin aynı isimdeki olanlarının toplamlarını almasını istiyorum
ben örneklere göre yapmaya çalıştım ama olmadı
Yardımlarınız için şimdiden teşşekkür ederim.

 

[veyselemre]

Sub AktarTopla()
    sut = Array(2, 3, 4)
    Application.ScreenUpdating = False
    y = Sheets("Sayfa1").Range("a2").CurrentRegion.Resize(, 4).Value
    ReDim j(1 To 4)
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For i = 2 To UBound(y, 1)
            If Not .exists(y(i, 1)) Then
                j(1) = y(i, 1)
                For Each s In sut
                    j(s) = Val(y(i, s))
                Next
                .Add y(i, 1), j
            Else
                j = .Item(y(i, 1))
                For Each s In sut
                    j(s) = Val(j(s)) + Val(y(i, s))
                Next
                .Item(y(i, 1)) = j
            End If
        Next
        y = .items
    End With

    With Sheets("Sayfa2")
        .Range("a2:d65536").ClearContents
        If UBound(y) > 0 Then
            y = WorksheetFunction.Transpose(WorksheetFunction.Transpose(y))
            .[a2].Resize(UBound(y, 1), 4).Value = y
        Else
            y = WorksheetFunction.Transpose(WorksheetFunction.Transpose(y))
            .[a2].Resize(, 4).Value = y
        End If
    End With
    Application.ScreenUpdating = True
    MsgBox "Bitti"
    Erase y, j, sut
End Sub

 

[Necdet]

Basit Mantıkla alternatif çözüm, Oku - Yaz - Bul ve Topla

Sub AktarTopla()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
s2.[A2:D65536].ClearContents
SonSatır = s1.[A65536].End(3).Row
For i = 2 To SonSatır
    Okunan = Okunan + 1
    Buldum = 0
    For j = 2 To s2.[A65536].End(3).Row
        If s1.Cells(i, "A") = s2.Cells(j, "A") Then
            Buldum = 1
            s2.Cells(j, "B") = s2.Cells(j, "B") + s1.Cells(i, "B")
            s2.Cells(j, "C") = s2.Cells(j, "C") + s1.Cells(i, "C")
            s2.Cells(j, "D") = s2.Cells(j, "D") + s1.Cells(i, "D")
        End If
    Next j
    
    If Buldum = 0 Then
       Adet = Adet + 1
       s2.Cells(j, "A") = s1.Cells(i, "A")
       s2.Cells(j, "B") = s1.Cells(i, "B")
       s2.Cells(j, "C") = s1.Cells(i, "C")
       s2.Cells(j, "D") = s1.Cells(i, "D")
     End If
Next i
s2.Range("A2:D" & s2.[A65536].End(3).Row).Sort key1:=s2.[A2]
MsgBox Okunan & " Kayıt Aktarılıp " & Adet & " Kayıtta Toplanmıştır"
End Sub

 

[fdisk]

Çok Sağolun

 

[fdisk]

Bununla ilgili 3 tane sayfadan yani stok miktarı gelen sipariş ve göndeilen
ürünleri karşılaştırıp aynı olan ürünülerin toplamını olacak nasıl olur yardımcı olabilirmisiniz.
saygılarımla.