SendKeys "^{s}" 'сохранить страницу полностью

Sleep (300)

SendKeys "{ENTER}" 'подтвердить сохранение по такому то адресу

Sleep (100)

SendKeys "%{Д}" 'заменить ли прошлый файл? - ДА

Workbooks.Open Filename:= _
        "D:\!Users\User1\Documents\Бизнес\Porno_negrov.com.html"

Dim arr(1 To 900000, 1 To 3)

st = 900000
Dim arr(1 To st, 1 To 3)

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
'bVk - Виртуальный код клавиши для имитации нажатия и отпускания клавиши.
'bScan - Зарезервировано -- установлено в 0.
'dwFlags - Комбинация следующих флагов определяет различные способы имитации:
'KEYEVENTF_EXTENDEDKEY - Префикс скэн-кода с префиксным байтом, имеющим значение &HE0.
'KEYEVENTF_KEYUP - Клавиша, указанная в bVk будет отпущена. Если этот флажок не определен, клавиша будет нажата.
'dwExtraInfo - Дополнительное 32-разрядное значение, связанное с событием клавиатуры.
Const KEYEVENTF_KEYUP = &H2 'событие отпускания клавиши
Const VK_CONTROL = &H11 'клавиша Ctrl

Sub клик()
Call keybd_event(VK_CONTROL, 0, 0, 0) 'Hажимаем Ctrl
mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
Call keybd_event(VK_CONTROL, 0, KEYEVENTF_KEYUP, 0) 'Отпускаем Ctrl
End Sub

Private Declare Function ActivateKeyboardLayout _
                          Lib "user32" (ByVal HKL As Long, ByVal flags As Long) As Long
Const kb_lay_ru As Long = 68748313, kb_lay_en As Long = 67699721
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal dwData As Long, ByVal dwExtraInfo As Long)
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Sub клик()
mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub

Sub клик()
Sendkeys "{^}" 'Sendkeys "{CTRL}" тоже не работает
mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub

.Cells(1, 1).FormulaR1C1Local = "=ИНДЕКС(I2:I24;ПОИСКПОЗ(P" & .[n1] & ";A2:A24;0))"

sub
SendKeys "^{f}"
SendKeys "^{v}"
SendKeys "{ENTER}"
end sub

Sub Макрос2()
Dim m As String
m = GetClipboard
    Cells.Find(What:=m, After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
End Sub

MsgBox GetClipboard

=ДРВ("cqg.rtd"; ;"ContractData"; "EU6?"; "Bid";; "T")

 If Not delRows Is Nothing Then

arrTemp = Range("J" & lRow - 8640 & ":J" & lRow).Value 

arrTemp = Range("B" & lRow - 8640 & ":B" & lRow).Value

Set delRows = Union(delRows, Rows(I))