Sub zzz()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
For i = 1 To 10000
    For j = 1 To 20
        Worksheets("Лист1").Cells(i, j) = 4
    Next j
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Sub zzz()
For i = 1 To 10000
    For j = 1 To 20

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

        Worksheets("Лист1").Cells(i, j) = 4
    Next j
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

1

Sub Вставить()
On Error GoTo 3
Range("$C$3").Select
    ActiveSheet.PasteSpecial Link:=False, DisplayAsIcon:= _
        False, NoHTMLFormatting:=True
Range("$C$3").Select
Exit Sub
3
MsgBox "Нет данных"
End Sub

Sub макрос1()
On Error GoTo 1
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
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 ' 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

Set maPageHtml = Nothing

DoEvents
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
    
    
    
  If Workbooks("книга1.xlsb").Worksheets("Лист6").Range("$y$30") = "2" Then   ' если появилась новая
    
    SendKeys ("{ }")

    Workbooks("книга1.xlsb").Activate
    Call Звук
    
    UserForm1.Show 0
   UserForm1.Hide
 
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 & ""), "Макрос1"
    End If
  
   End If
   
Exit Sub

1
Workbooks("книга1.xlsb").Activate
Call Звук2
UserForm1.Show 0
UserForm1.Hide

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

For i = 1 To maTable.Rows.Length
Application.Calculation = xlCalculationManual
    For J = 1 To maTable.Rows(i - 1).Cells.Length
    Application.Calculation = xlCalculationManual
        Workbooks("книга.xlsb").Worksheets("table").Cells(i, J) = maTable.Rows(i - 1).Cells(J - 1).innerText
    Next J
Next i

Sub Кнопка52_Щелчок1()
s2 = ("http://www.planetaexcel.ru") 'первая ссылка
UserForm2.WebBrowser2.navigate (s2) 'переходим на ссылку
Do While UserForm2.WebBrowser2.busy Or (UserForm2.WebBrowser2.ReadyState <> 4): DoEvents: Loop ';ждем загрузки страницы
DoEvents
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Worksheets("table4").Cells.ClearContents 'удаляем все предыдущие записи на листе table4
Worksheets("table4").Range("$a$1") = UserForm2.WebBrowser2.Document.body.innerText ' Вставляет все в одну ячейку
 DoEvents
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Sub Кнопка471_Щелчок()
Application.OnTime Now + TimeValue("00:00:05"), "qqq"
End Sub

Sub qqq()
SendKeys ("{ENTER}")
End Sub