Sub ASSummary()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rngBase1 As Range
Dim rngBase2 As Range
Dim rngCell As Range
Dim lngQty As Long

Set ws1 = ActiveWorkbook.Sheets("Base_1")
Set ws2 = ActiveWorkbook.Sheets("Base_2")
Set wsSum = ActiveWorkbook.Sheets("Resumo")

   With Application
      .ScreenUpdating = False
      .EnableEvents = False
   End With

      With ws1
         Set rngBase1 = .Range("B2", .Range("B2").End(xlDown))
      End With

      With ws2
         Set rngBase2 = .Range("B2", .Range("B2").End(xlDown))
      End With

      For Each rngCell In rngBase1
         lngQty = rngCell.Offset(0, -1).Value
         Set rngFound = ws2.Columns(2).Find(What:=rngCell, LookIn:=xlValues, LookAt:= _
                                            xlPart, SearchOrder:=xlByRows)
            If Not rngFound Is Nothing Then
               lngQty = lngQty + rngFound.Offset(0, -1).Value
            End If
            With wsSum
               Set rngDest = .Range("A2000").End(xlUp).Offset(1)
            End With
            rngDest.Value = lngQty
            rngDest.Offset(0, 1) = rngCell
            rngDest.Offset(0, 2) = rngCell.Offset(0, 1)
      Next

      For Each rngCell In rngBase2
         Set rngFound = ws1.Columns(2).Find(What:=rngCell, LookIn:=xlValues, LookAt:= _
                                            xlPart, SearchOrder:=xlByRows)
            If rngFound Is Nothing Then
               With wsSum
                  Set rngDest = .Range("A2000").End(xlUp).Offset(1)
               End With
            rngCell.Offset(0, -1).Resize(1, 3).Copy
            rngDest.Resize(1, 3).PasteSpecial xlPasteValues
            End If
      Next

   With Application
      .ScreenUpdating = True
      .EnableEvents = True
   End With

End Sub