Sub ВставитьWord()
    Dim LastRow As Long
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Dim objWrdApp As Object, objWrdDoc As Object
    On Error Resume Next
    Set objWrdApp = GetObject(, "Word.Application")
    If objWrdApp Is Nothing Then
        Select Case MsgBox("Не найдено открытых документов Word. Создать новый?", 52, "")
        Case 6    ' Да
            Set objWrdApp = CreateObject("Word.Application")
            objWrdApp.Visible = True
            Set objWrdDoc = objWrdApp.Documents.Add
        Case 7    ' Нет
            Exit Sub
        End Select
    Else
        Set objWrdDoc = objWrdApp.activedocument

    End If
    ThisWorkbook.Sheets(1).Range(Cells(2, 1), Cells(LastRow, 4)).Copy
    objWrdDoc.ActiveWindow.Selection.Paste
    Application.CutCopyMode = False
    Set objWrdDoc = Nothing
    Set objWrdApp = Nothing

End Sub

=SUM($D$2:D6)/SUM($D$2:$D$13)

Private Sub TextBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    
    On Error Resume Next
    Dim check As Range, tb$, symb, col
    
    symb = chr(KeyAscii)
    tb = Me.TextBox.Value
    col = tb & symb
    If IsNumeric(col) Then col = CDbl(col)

    Set check = Columns(col)
    If Err.Number <> 0 Then
        KeyAscii = 0
        Err.Clear
    End If

End Sub

ВПР(F2;aa;2)+(F2-ВПР(F2;aa;1))*ВПР(F2;aa;3)%

Sub test()

    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = True
    ie.Navigate ("https://rosreestr.ru/wps/portal/p/cc_ib_portal_services/online_request/")

    Do Until ie.readyState = 4    'For STATE as COMPLETE
        DoEvents
    Loop

    ie.Document.GetElementsByName("cad_num")(0).Value = "26:12:010530:492"
    ie.Document.GetElementById("submit-button").Click


    Do Until Not ie.Busy And ie.readyState = 4
        DoEvents
    Loop
    a = (ie.Document.GetElementById("js_oTr0").Cells(0).ChildNodes.Item(1).href)
    ie.Navigate a

End Sub

Sub unite()
    Dim o_dict As Object
    Set o_dict = CreateObject("Scripting.dictionary")
    Dim arr_in
    arr_in = Range("B5:C12").Value
    For i = LBound(arr_in) To UBound(arr_in)
        For n = LBound(arr_in, 2) To UBound(arr_in, 2)
            If arr_in(i, n) <> "" Then a = o_dict(arr_in(i, n))
        Next n
    Next i
    arr_out = o_dict.keys
    Range("E5").Resize(UBound(arr_out) + 1).Value = Application.Transpose(arr_out)
End Sub