Private Sub Workbook_Open()

Dim app As New Excel.Application
Dim book As Excel.Workbook
Dim yy1, yy
Dim a(), tt&, x&, i&, ii&
aa = Array(1, 6, 9, 10, 13, 14, 15, 16) 'создаем ряд с номерами столбцов
app.Visible = False 'Visible is False by default, so this isn't necessary
If Len(Dir("\\Server\sapreports\" & Format(Date, "yyyymmdd") & "\New_3Clmn_Open_SO_cust-model-q-ty.xls", vbDirectory)) = 0 Then Exit Sub 'если нету папки обрываем процедуру
Set book = app.Workbooks.Add("\\Server\sapreports\" & Format(Date, "yyyymmdd") & "\New_3Clmn_Open_SO_cust-model-q-ty.xls")
a() = book.Sheets("Table").[F14].CurrentRegion.Value

 ii = 0
    With CreateObject("Scripting.Dictionary"): .comparemode = 1
        For i = 3 To UBound(a) 
            t = Trim(a(i, 6)) 
            If .exists(t) Then 
                tt = .Item(t) 
                For x = 2 To 7: a(tt, x) = a(tt, x) + a(i, aa(x)): Next 
            Else 'если запись отсутствует, создаем новую
                ii = ii + 1
                .Item(t) = ii
                For x = 1 To 7: a(ii, x) = a(i, aa(x)): Next
            End If
        Next
    End With
For xSheet = ActiveWorkbook.Sheets.Count - 1 To ActiveWorkbook.Sheets.Count 'цыкл по последним двум листам
    xNumFind = Sheets(xSheet).Range("B2").End(xlDown).Row 
    For xStatus = 2 To xNumFind
        For statSO = 1 To ii 
            If Chr(34) & Workbooks(ActiveWorkbook.Name).Sheets(xSheet).Cells(xStatus, 4).Value & Chr(34) = Chr(34) & a(statSO, 1) & Chr(34) Then
                Workbooks(ActiveWorkbook.Name).Sheets(xSheet).Cells(xStatus, 10) = a(statSO, 3) 
                If a(statSO, 4) > 0 Then Workbooks(ActiveWorkbook.Name).Sheets(xSheet).Cells(xStatus, 12) = "отгружено" Else Workbooks(ActiveWorkbook.Name).Sheets(xSheet).Cells(xStatus, 12) = "не отгружено"
                If a(statSO, 6) > 0 Then Workbooks(ActiveWorkbook.Name).Sheets(xSheet).Cells(xStatus, 14) = "Unconfirmed" Else Workbooks(ActiveWorkbook.Name).Sheets(xSheet).Cells(xStatus, 14) = "Confirmed"
                GoTo R1
            End If
        Next
R1: Next
Next

book.Close SaveChanges:=False
app.Quit
Set app = Nothing
End Sub