Sub Parser()
 
    Set oHttp = CreateObject("MSXML2.XMLHTTP")
    Set objRegExp = CreateObject("VBScript.RegExp")
     
    URL = "https://www.sima-land.ru/4794023/nabor-dlya-sortirovki-sorter-bomboshki/"
    URL_autorization = "https://www.sima-land.ru/api/v3/login-form/"
    entity = "******"
    Password = "******"
    g_recaptcha_response = " "
    PostData = "g_recaptcha_response: " & ", entity: " & entity & ", password: " & Password

    'Подсмотрел в Request Payload но не могу написать запрос, что бы авторизоваться
    '"{"g_recaptcha_response": "", "entity": "******", "password": "******"}"

    With oHttp
       .Open "post", URL_autorization, False
       .Send PostData
    End With
    
    'После авторизации переходим на страницу с товаром и копируем код страницы в переменную
    
    oHttp.Open "GET", URL, False
    oHttp.Send
    htmlcode = oHttp.ResponseText
    Set oHttp = Nothing
    
    'Ищем на странице информацию об остатке товара, если авторизация прошла, то будет количество,
    'если нет то будет надпись "На складе достаточно"

    ссылкаНачало = InStr(1, htmlcode, "На складе")
    ссылкаКонец = InStr(ссылкаНачало, htmlcode, "<")
    outstr = Mid(htmlcode, ссылкаНачало, ссылкаКонец - ссылкаНачало)
    Cells(1, 1) = outstr
 
End Sub

Cells.FormatConditions.Delete

Sub Макрос3()

On Error Resume Next
ActiveSheet.ShowAllData
    Range("A7:H23").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Range("A1:H4"), Unique:=False
End Sub

Sub размер()
Application.ScreenUpdating = False
lLastRow = Cells(Rows.Count, 21).End(xlUp).Row
    For i = 10 To lLastRow
        If Cells(i, 21) <> 0 Then
        Cells(i, 21).RowHeight = 6
        End If
    Next
Application.ScreenUpdating = True
End Sub

outstr = Replace(outstr, Chr(9), "")