Помогите пожалуйста с макросом для работы с архивом

[tchipa5]

Добрый вечер!

[pashulka]

Если штрих код уникален, т.е. он не повторяется, то цикл, равно как и "отключение" обновления экрана - не нужны.

Код: Выделить всё

Private Sub Test()
    Dim ws As Worksheet, c As Range, s$
    
    s = InputBox("Введите штрих код")
    If s = "" Then MsgBox "Ошибка пользователя", vbCritical, "": Exit Sub
    
    Set ws = ThisWorkbook.Worksheets("Лист2")
    Set c = Application.Range("Выгрузка!A:A").Find(s, , xlValues, xlWhole)
    If Not c Is Nothing Then
       With c.Resize(, 14)
            .Copy ws.Cells(ws.Rows.Count, 1).End(xlUp)(2)
            .Interior.Color = vbYellow
       End With
    Else
       MsgBox "Штрих код " & s & " не найден", vbCritical, ""
    End If
End Sub