Sub Отработано()
      With Лист1
      m = .Range("A1").Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 6)
      End With
      With CreateObject("Scripting.Dictionary")
      For i = 1 To UBound(m)
          .Item(m(i, 1)) = .Item(m(i, 1)) + m(i, 6)
      Next i
      Лист1.Range("L1").Resize(.Count) = Application.Transpose(.keys)
      Лист1.Range("M1").Resize(.Count) = Application.Transpose(.items)
      End With
End Sub

Лист1.Range("L1").Resize(.Count) = Application.Transpose(.keys)
Лист1.Range("M1").Resize(.Count) = Application.Transpose(.items)

Лист2.Range("L1").Resize(.Count) = Application.Transpose(.keys)
Лист2.Range("M1").Resize(.Count) = Application.Transpose(.items)

Option Explicit

Sub Отработано()
Dim K, M, i, OD
Set OD = CreateObject("Scripting.Dictionary")
        With Лист1
        M = .Range("A2").Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 8)
        End With
           
        With Лист2
        K = .Range("A2").Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 12)
        End With

        For i = 1 To UBound(M)
           If M(i, 1) <> "" Then OD(M(i, 1)) = OD(M(i, 1)) + M(i, 6)
        Next i
           
        For i = 1 To UBound(K)
           If K(i, 1) <> "" Then OD(K(i, 1)) = OD(K(i, 1)) - K(i, 12)
        Next i
           
        For Each i In OD.keys
           If OD.Item(i) = 0 Then OD.Remove (i)
        Next
           
        With Worksheets.Add
           .Range("A1").Resize(OD.Count) = Application.Transpose(OD.keys)
           .Range("B1").Resize(OD.Count) = Application.Transpose(OD.items)
           .Columns(1).ColumnWidth = 15
        End With
         
End Sub