HELP VBA Menjumlahkan duplicate data dan membuat sheet baru

[sh3nmue]

plis help agan2... ada yg bisa bantuin,,,

ane punya sheet namanya INPUT..
isinya ada 3 table dan masing2 punya 2 kolom yaitu Kode barang dan jumlah barang,,,
nah masalahnya, pada bagian kode brg dari setiap table itu inputnya ada yang sama/duplikat,,, tapi jumlah quantitynya beda,,,,

jadi ane bermaksud bikin tombol macro vba yang bisa membuat sheet baru yang bernama Summary_report dan isinya sama seperti sheet INPUT hanya saja datanya sudah tersortir/di-urutkan dan data yang sama/duplikat sudah dijumlahkan...

 

[sh3nmue]

UP dulu gan...

 

[sh3nmue]

PROBLEM SOLVED

Sub CreateSummaryReport()

  Dim Cell As Range
  Dim Data() As Variant
  Dim DSO As Object
  Dim Key As Variant
  Dim Keys As Variant
  Dim I As Long
  Dim Item As Variant
  Dim Items As Variant
  Dim Rng As Range
  Dim RngEnd As Range
  Dim SumWks As Worksheet
  Dim Wks As Worksheet
  
    On Error Resume Next
      Set SumWks = Worksheets("Summary_Report")
        If Err = 9 Then
           Err.Clear
           Worksheets.Add.Name = "Summary_Report"
           Set SumWks = ActiveSheet
             Cells(1, "A") = "CODE"
             Cells(1, "B") = "QTY"
             Rows(1).Font.Bold = True
             Columns("A:B").AutoFit
        End If
    On Error GoTo 0
    
    Set DSO = CreateObject("Scripting.Dictionary")
    DSO.CompareMode = vbTextCompare
    
      For Each Wks In Worksheets
        If Wks.Name = "INPUT" Then
           Set Rng = Wks.Range("A1")
           Set RngEnd = Rng.Cells(Rows.Count, Rng.Column).End(xlUp)
           Set Rng = IIf(RngEnd.Row < Rng.Row, Rng, Wks.Range(Rng, RngEnd))
             For Each Cell In Rng
               Key = Trim(Cell.Value)
               Item = Cell.Offset(0, 1).Value
               If Key <> "" Then
                 If Not DSO.Exists(Key) Then
                    DSO.Add Key, Item
                 Else
                    DSO(Key) = DSO(Key) + Item
                 End If
               End If
             Next Cell
        End If
      Next Wks
      
      With SumWks
        .UsedRange.Offset(1, 0).ClearContents
        Keys = DSO.Keys
        Items = DSO.Items
          For I = 0 To DSO.Count - 1
            .Cells(I + 2, "A") = Keys(I)
            .Cells(I + 2, "B") = Items(I)
          Next I
        .UsedRange.Sort Key1:=.Cells(2, 1), Order1:=xlAscending, _
                        Header:=xlYes, Orientation:=xlSortColumns
      End With
    
    Set DSO = Nothing
    
End Sub