Application.Interactive = False
For i = 1 To maTable.Rows.Length ' table rows
'DoEvents
    For J = 1 To maTable.Rows(i - 1).Cells.Length ' each cell of the row
    'DoEvents
        Workbooks("книга1.xlsb").Worksheets("table").Cells(i, J) = maTable.Rows(i - 1).Cells(J - 1).innerText
    Next J
Next i
Application.Interactive = True

Application.OnTime Now + TimeValue("00:00:" & obnov & ""), "Макрос1"

Application.OnTime Now + TimeValue("00:00:" & obnov & ""), "Module1.Макрос1"

SendKeys ("{ }")

Call макрос1

Module1.Макрос1

Sub макрос1()
On Error GoTo 1' Если убрать On Error GoTo, то макрос просто останавливается не выдавая не каких ошибок
Application.EnableCancelKey = xlDisabled
dt1 = Now
dt2 = Now + 1
obnov = 10
s = ("http://100.20.29.225")' Страница ввода данных
UserForm2.WebBrowser1.Navigate (s)
Do While UserForm2.WebBrowser1.busy Or (UserForm2.WebBrowser1.ReadyState <> 4): DoEvents: Loop
'Вводим данные и расставляем чек боксы 
v_pr1 = v_prob1
v_pr2 = v_prob2
v_D1 = Format(CDate(dt1), "dd/mm/yyyy")
v_D2 = Format(CDate(dt2), "dd/mm/yyyy")
v_N1 = Plavka1
v_N2 = Plavka2
 
UserForm2.WebBrowser1.Document.forms(0).elements(0).Checked = True
UserForm2.WebBrowser1.Document.forms(0).elements(13).Checked = True
UserForm2.WebBrowser1.Document.forms(0).elements(2).Value = v_pr1
UserForm2.WebBrowser1.Document.forms(0).elements(3).Value = v_pr2
UserForm2.WebBrowser1.Document.forms(0).elements(14).Value = v_D1
UserForm2.WebBrowser1.Document.forms(0).elements(15).Value = v_D2
UserForm2.WebBrowser1.Document.forms(0).elements(16).Value = v_N1
UserForm2.WebBrowser1.Document.forms(0).elements(17).Value = v_N2
UserForm2.WebBrowser1.Document.forms(0).elements(19).Checked = True
 
DoEvents

UserForm2.WebBrowser1.Document.forms(0).submit' Нажимаем кнопку "Выбор" на странице и переходим в таблицу Хим анализа
 
DoEvents' Если убрать, то на лист excel приходят данные со страницы выбора параметров

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Do While UserForm2.WebBrowser1.busy Or (UserForm2.WebBrowser1.ReadyState <> 4): DoEvents: Loop
Set maPageHtml = UserForm2.WebBrowser1.Document
Set Htable = maPageHtml.getElementsByTagName("table")
Set maTable = Htable(1) ' the first table
Workbooks("книга1.xlsb").Worksheets("table").Cells.ClearContents 'удаляем все предыдущие записи на листе table

'запускаем цикл по всем ячейкам - последовательно заносим их на лист

For i = 1 To maTable.Rows.Length
    For J = 1 To maTable.Rows(i - 1).Cells.Length
        Workbooks("книга1.xlsb").Worksheets("table").Cells(i, J) = maTable.Rows(i - 1).Cells(J - 1).innerText
    Next J
Next i
 
Set maPageHtml = Nothing
 
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
     
     
     
  If Workbooks("книга1.xlsb").Worksheets("Лист6").Range("$y$30") = "2" Then   ' если появилась новая
 
    Workbooks("книга1.xlsb").Activate
    Call Звук
  
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
  
Workbooks("книга1.xlsb").Worksheets("Лист2").Range("$g$17") = "3"
    Workbooks("книга1.xlsb").Worksheets("Лист2").Range("$g$16") = "1"
        Workbooks("книга1.xlsb").Sheets("Лист2").Range("$l$3") = dt1
    Workbooks("книга1.xlsb").Sheets("Лист2").Range("$m$3") = dt2
   Workbooks("книга1.xlsb").Worksheets("Лист6").Range("$b$7") = Workbooks("книга1.xlsb").Worksheets("Лист6").Range("$g$7")
Workbooks("книга1.xlsb").Worksheets("Лист6").Range("$c$7") = Workbooks("книга1.xlsb").Worksheets("Лист6").Range("$h$7")
      
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
 poiskPR = Workbooks("книга1.xlsb").Worksheets("Лист6").Range("$t$28")
    MsgBox "Плавка №: " & Workbooks("книга1.xlsb").Worksheets("Лист6").Range("$j$4") & "  Проба №: " & Workbooks("книга1.xlsb").Worksheets("Лист6").Range("$K$4"), vbSystemModal
Else
    If Workbooks("книга1.xlsb").Worksheets("Лист2").Range("$g$16") = "5" Then
    obnov = 10
    Application.OnTime Now + TimeValue("00:00:" & obnov & ""), "Module1.Макрос1"
    End If
   
   End If
    
Exit Sub
 
1
Workbooks("книга1.xlsb").Activate
Call Звук2
 
If MsgBox("Неполадки с сетью. Продолжить обработку?", vbYesNo) = vbYes Then
Call макрос1
Else
Workbooks("книга1.xlsb").Worksheets("Лист2").Range("$g$17") = "3"
Workbooks("книга1.xlsb").Worksheets("Лист2").Range("$g$16") = "1"
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End If
 
End Sub