Sub aaa()
Dim aa As Range, bb As Range, cc As Range, sh As Worksheet, a&, dt1$, mm, arr()
With Sheets(1)
  dt1 = .[C1]: mm = .[C3]
  Set aa = .[B7:G13]: arr = aa.Value 'диапазон с данными в накладной
End With
On Error Resume Next
mm = CDate(mm)
If Err.Number <> 0 Then Err.Clear: MsgBox "В ячейке [C3] не дата!", vbInformation: Exit Sub
For Each sh In ThisWorkbook.Worksheets
  If InStr(1, sh.Name, dt1, 1) > 0 Or InStr(1, dt1, sh.Name, 1) > 0 Then Exit For
Next
If sh Is Nothing Then MsgBox "В книге нет листа с введенной торговой точкой!", vbCritical: Exit Sub
For Each bb In sh.UsedRange.EntireRow.Rows(1).Columns("G:BP")
  If bb.Value = mm Then Exit For
Next
If bb Is Nothing Then MsgBox "Нет такой даты на листе!", vbCritical: Exit Sub
For a = 1 To UBound(arr, 1)
  If Len(arr(a, 1)) > 0 Then
    Set cc = sh.UsedRange.EntireColumn(1).Find(arr(a, 1), , xlValues, xlByColumns, xlPrevious, False)
    If Not cc Is Nothing Then
      Intersect(cc.EntireRow, bb.EntireColumn).Value = Intersect(cc.EntireRow, bb.EntireColumn).Value + arr(a, 2)
      Intersect(cc.EntireRow, bb.EntireColumn).Offset(, 1).Value = Intersect(cc.EntireRow, bb.EntireColumn).Offset(, 1).Value + arr(a, 5)
    End If
  End If
Next
Union(Intersect(aa, Sheets(1).Columns("C")), Intersect(aa, Sheets(1).Columns("F"))).ClearContents
End Sub