let
    url = "https://card.wb.ru/cards/detail",
    headers = [
        #"Accept" = "*/*",
        #"Accept-Language" = "en-US,en;q=0.9",
        #"Connection" = "keep-alive",
        #"Origin" = "https://www.wildberries.ru",
        #"Referer" = "https://www.wildberries.ru/catalog/"&art&"/detail.aspx?targetUrl=GP",
        #"Sec-Fetch-Dest" = "empty",
        #"Sec-Fetch-Mode" = "cors",
        #"Sec-Fetch-Site" = "cross-site",
        #"User-Agent" = "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/107.0.0.0 Safari/537.36",
        #"sec-ch-ua" = "^\^Google",
        #"sec-ch-ua-mobile" = "?0",
        #"sec-ch-ua-platform" = "^\^Windows^^"
    ],
    parameters = [
        #"spp" = "26",
        #"regions" = "80,64,83,4,38,33,70,82,69,68,86,30,40,48,1,22,66,31",
        #"pricemarginCoeff" = "1.0",
        #"reg" = "1",
        #"appType" = "1",
        #"emp" = "0",
        #"locale" = "ru",
        #"lang" = "ru",
        #"curr" = "rub",
        #"couponsGeo" = "2,12,7,3,6,18,21",
        #"sppFixGeo" = "4",
        #"dest" = "-1029256,-85617,-543140,-1586279",
        #"nm" = art
    ],
    response = Web.Contents(url, [
        Query = parameters,
        Headers = headers
    ]),
    json = Json.Document( response ),
    totable = Table.PromoteHeaders(Table.Transpose(Record.ToTable(json[data][products]{0}))),
    #"Removed Columns" = Table.SelectColumns(totable,{"id", "name", "brand", "priceU", "sale", "salePriceU","sizes","rating"}),
    #"Divided Column" = Table.TransformColumns(#"Removed Columns", {{"priceU", each _ / 100, type number}, {"salePriceU", each _ / 100, type number}})
in
    #"Divided Column"

Private Sub Workbook_Open()
Application.Calculation = xlCalculationManual
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lLastRow1 As Long, lLastRow2 As Long, n As Long
Dim fcell As Range, lLastRow2new As Long

Set ws1 = Sheets("Мониторинг Вык.,Зак.,Ост.")
Set ws2 = Sheets("Архив")
lLastRow1 = ws1.Cells(Rows.Count, 21).End(xlUp).Row
lLastRow2 = ws2.Cells(Rows.Count, 21).End(xlUp).Row

ws1.Range("AA3:AA" & lLastRow1 + 1).FormulaR1C1 = "=RC[-5]&RC[-1]"
ws2.Range("AA3:AA" & lLastRow2 + 1).FormulaR1C1 = "=RC[-5]&RC[-1]"

For n = 3 To lLastRow1 + 1
If ws1.Cells(n, 27) <> "" Then
Set fcell = ws2.Range("AA3:AA" & lLastRow2 + 1).Find(ws1.Cells(n, 27), LookIn:=xlValues)
If fcell Is Nothing Then
lLastRow2new = ws2.Cells(Rows.Count, 21).End(xlUp).Row
ws1.Range(ws1.Cells(n, 21), ws1.Cells(n, 26)).Copy ws2.Cells(lLastRow2new + 1, 21)
End If
End If
Next

lLastRow1 = ws1.Cells(Rows.Count, 33).End(xlUp).Row
lLastRow2 = ws2.Cells(Rows.Count, 33).End(xlUp).Row

For n = 3 To lLastRow1 + 1
If ws1.Cells(n, 38) <> "" Then
Set fcell = ws2.Range("AL3:AL" & lLastRow2 + 1).Find(ws1.Cells(n, 38), LookIn:=xlValues)
If fcell Is Nothing Then
lLastRow2new = ws2.Cells(Rows.Count, 33).End(xlUp).Row
ws1.Range(ws1.Cells(n, 33), ws1.Cells(n, 38)).Copy ws2.Cells(lLastRow2new + 1, 33)
End If
End If
Next

ws1.Range("AA3:AA" & lLastRow1 + 1).ClearContents
ws2.Range("AA3:AA" & lLastRow2 + 1).ClearContents

Application.Calculation = xlCalculationAutomatic
End Sub

Sub Workbook_Open()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lLastRow1 As Long, lLastRow2 As Long, n As Long
    Dim fcell As Range, lLastRow2new As Long

    Set ws1 = Sheets("Мониторинг Вык.,Зак.,Ост.")
    Set ws2 = Sheets("Архив")
    lLastRow1 = ws1.Cells(Rows.Count, 21).End(xlUp).Row
    lLastRow2 = ws2.Cells(Rows.Count, 21).End(xlUp).Row

    ws1.Range("AA3:AA" & lLastRow1 + 1).FormulaR1C1 = "=RC[-5]&RC[-1]"
    ws2.Range("AA3:AA" & lLastRow2 + 1).FormulaR1C1 = "=RC[-5]&RC[-1]"

    Set fcell = ws2.Range("AA3:AA" & lLastRow2 + 1).Find(ws1.Cells(3, 27), LookIn:=xlValues)
    For n = 3 To lLastRow1 + 1
        If ws1.Cells(n, 27) <> "" Then
            If fcell Is Nothing Then
                lLastRow2new = ws2.Cells(Rows.Count, 21).End(xlUp).Row
                ws1.Range(ws1.Cells(n, 21), ws1.Cells(n, 26)).Copy ws2.Cells(lLastRow2new + 1, 21)
            Else
                Set fcell = fcell.FindNext(fcell)
            End If
        End If
    Next

    lLastRow1 = ws1.Cells(Rows.Count, 33).End(xlUp).Row
    lLastRow2 = ws2.Cells(Rows.Count, 33).End(xlUp).Row

    Set fcell = ws2.Range("AL3:AL" & lLastRow2 + 1).Find(ws1.Cells(3, 38), LookIn:=xlValues)
    For n = 3 To lLastRow1 + 1
        If ws1.Cells(n, 38) <> "" Then
            If fcell Is Nothing Then
                lLastRow2new = ws2.Cells(Rows.Count, 33).End(xlUp).Row
                ws1.Range(ws1.Cells(n, 33), ws1.Cells(n, 38)).Copy ws2.Cells(lLastRow2new + 1, 33)
            Else
                Set fcell = fcell.FindNext(fcell)
            End If
        End If
    Next

   
ws1.Range("AA3:AA" & lLastRow1 + 1).ClearContents
ws2.Range("AA3:AA" & lLastRow2 + 1).ClearContents

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Private Sub Workbook_Open()
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
 Dim ws1 As Worksheet, ws2 As Worksheet
 Dim lLastRow1 As Long, lLastRow2 As Long, n As Long
 Dim fcell As Range, lLastRow2new As Long

  Set ws1 = Sheets("Лист1")
  Set ws2 = Sheets("Лист2")
  lLastRow1 = ws1.Cells(Rows.Count, 21).End(xlUp).Row
  lLastRow2 = ws2.Cells(Rows.Count, 21).End(xlUp).Row

  ws1.Range("AA3:AA" & lLastRow1 + 1).FormulaR1C1 = "=RC[-5]&RC[-1]"
  ws2.Range("AA3:AA" & lLastRow2 + 1).FormulaR1C1 = "=RC[-5]&RC[-1]"

 For n = 3 To lLastRow1 + 1
  If ws1.Cells(n, 27) <> "" Then
   Set fcell = ws2.Range("AA3:AA" & lLastRow2 + 1).Find(ws1.Cells(n, 27), LookIn:=xlValues)
    If fcell Is Nothing Then
     lLastRow2new = ws2.Cells(Rows.Count, 21).End(xlUp).Row
     ws1.Range(ws1.Cells(n, 21), ws1.Cells(n, 26)).Copy ws2.Cells(lLastRow2new + 1, 21)
    End If
  End If
 Next

  lLastRow1 = ws1.Cells(Rows.Count, 33).End(xlUp).Row
  lLastRow2 = ws2.Cells(Rows.Count, 33).End(xlUp).Row

 For n = 3 To lLastRow1 + 1
  If ws1.Cells(n, 38) <> "" Then
   Set fcell = ws2.Range("AL3:AL" & lLastRow2 + 1).Find(ws1.Cells(n, 38), LookIn:=xlValues)
    If fcell Is Nothing Then
     lLastRow2new = ws2.Cells(Rows.Count, 33).End(xlUp).Row
     ws1.Range(ws1.Cells(n, 33), ws1.Cells(n, 38)).Copy ws2.Cells(lLastRow2new + 1, 33)
    End If
  End If
 Next

ws1.Range("AA3:AA" & lLastRow1 + 1).ClearContents
ws2.Range("AA3:AA" & lLastRow2 + 1).ClearContents

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Sub aaa()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

lLastRow1 = ActiveSheet.Cells(Rows.Count, 15).End(xlUp).Row
lLastRow2 = Sheets("Архив").Cells(Rows.Count, 15).End(xlUp).Row

ActiveSheet.Range("AA3:AA" & lLastRow1 + 1).FormulaR1C1 = "=RC[-8]&RC[-1]"
Sheets("Архив").Range("AA3:AA" & lLastRow2 + 1).FormulaR1C1 = "=RC[-8]&RC[-1]"

For n = 2 To lLastRow1 + 1
    If ActiveSheet.Cells(n, 27) <> "" Then
        Set fcell = Sheets("Архив").Range("AA3:AA" & lLastRow2 + 1).Find(ActiveSheet.Cells(n, 27), LookIn:=xlValues)
        If fcell Is Nothing Then
            lLastRow2new = Sheets("Архив").Cells(Rows.Count, 15).End(xlUp).Row
            ActiveSheet.Range(Cells(n, 15), Cells(n, 26)).Copy Sheets("Архив").Cells(lLastRow2new + 1, 15)
        End If
    End If
Next

ActiveSheet.Range("AA3:AA" & lLastRow1 + 1).ClearContents
Sheets("Архив").Range("AA3:AA" & lLastRow2 + 1).ClearContents

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub