Sub Test2()
    Dim oConn As Object, Sh As Worksheet, Rng As Range
    Dim objRS As Object, IsStart As Boolean
    Dim sPath, avr, cel As Range
    Set List = CreateObject("scripting.dictionary")
    Set Sh = ActiveSheet
    LastRow = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Row

    Set xx = Sh.Columns("C:C").Find("от Заказчика", , , xlWhole)
    If xx Is Nothing Then Exit Sub
    Set Rng = Sh.Range("A" & (xx.Row + 1) & ":A" & LastRow)

    sPath = "C:\Users\Сергей\Downloads\1111.xlsx"    'Указывайте свой путь
    Set oConn = CreateObject("ADODB.Connection")
    oConn.CursorLocation = 3
    oConn.Open "DBQ=" & sPath & ";Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)}"
    sSql = "SELECT * FROM [1111$]"
    Set objRS = oConn.Execute(sSql)
    li = objRS.RecordCount
    avr = objRS.getrows
    ReDim res(1 To li + 1, 1 To UBound(avr) + 1)
    For n = 0 To UBound(avr)
        res(1, n + 1) = objRS.Fields(n).Name
    Next
    For n = 0 To UBound(avr, 2)
        For i = 0 To UBound(avr)
            If Not IsNull(avr(i, n)) Then
                res(n + 2, i + 1) = avr(i, n)
            End If
        Next
        If IsStart = True Then
            Key$ = res(n + 1, 1)
            If Key$ <> "" Then
                ss = Val(Replace(res(n + 1, 21), ",", "."))
                If List.Exists(Key) Then
                    List.Item(Key) = List.Item(Key) + ss
                Else
                    List.Item(Key) = ss
                End If

            End If
        End If
        If res(n + 1, 1) = "Ключ" Then
            IsStart = True
        End If

    Next
    For Each cel In Rng
        Key$ = cel
        If Key <> "" Then
            If List.Exists(Key) Then
                ss = List.Item(Key)
                cel.Offset(0, 11) = ss
            End If
        End If
    Next
End Sub