Sub CollectNonZeroStock()
    Dim ws As Worksheet
    Dim resultWs As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim outputRow As Long
    
    ' Отключаем обновление экрана для скорости
    Application.ScreenUpdating = False
    
    ' Проверяем, существует ли уже лист "Итог"
    On Error Resume Next
    Set resultWs = ThisWorkbook.Worksheets("Итог")
    On Error GoTo 0
    
    ' Если листа нет, создаем его в конце книги
    If resultWs Is Nothing Then
        Set resultWs = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        resultWs.Name = "Итог"
    Else
        ' Если лист есть, очищаем его содержимое, но оставляем форматирование
        resultWs.Cells.ClearContents
    End If
    
    ' Заголовки на итоговом листе
    With resultWs
        .Range("A1").Value = "Артикул"
        .Range("B1").Value = "Остаток"
        .Range("A1:B1").Font.Bold = True
    End With
    
    outputRow = 2 ' Начинаем записывать данные со второй строки
    
    ' Проходим по всем листам книги
    For Each ws In ThisWorkbook.Worksheets
        ' Пропускаем лист "Итог", чтобы избежать рекурсии, если он изначально был в книге
        If ws.Name <> "Итог" Then
            ' Определяем последнюю строку с данными в столбце B (где лежат артикулы)
            lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
            
            ' Если на листе вообще есть данные (минимум одна строка после заголовка)
            If lastRow >= 2 Then
                ' Пробегаемся по строкам
                For i = 2 To lastRow
                    ' Проверяем, что в ячейке остатка именно число и оно больше нуля
                    ' Trim удаляет случайные пробелы, которые мешают преобразованию текста в число
                    If IsNumeric(Trim(ws.Cells(i, "E").Value)) And CDbl(Trim(ws.Cells(i, "E").Value)) > 0 Then
                        resultWs.Cells(outputRow, "A").Value = ws.Cells(i, "B").Value
                        resultWs.Cells(outputRow, "B").Value = ws.Cells(i, "E").Value
                        outputRow = outputRow + 1
                    End If
                Next i
            End If
        End If
    Next ws
    
    ' Автоподбор ширины столбцов для удобства чтения
    resultWs.Columns.AutoFit
    
    ' Возвращаем обновление экрана
    Application.ScreenUpdating = True
    
    ' Переключаемся на созданный лист
    resultWs.Activate
    
    MsgBox "Сбор данных завершен. Найдено позиций с ненулевым остатком: " & outputRow - 2, vbInformation
End Sub