Вот такой небольшой макрос выберет уникальные записи:
Код:
Sub UuniqueArticles()
Dim ArrData(), ArrRes()
Dim lRws As Long
Dim i As Long, j As Long, k As Long
Application.ScreenUpdating = False ' отключаем обновление экрана (чтобы не "моргал")
With ActiveSheet
lRws = .UsedRange.Row + .UsedRange.Rows.Count - 1 ' последняя строка с данными
ArrData = .Range("A4:G" & lRws).Value ' данные листа в массив
' задаем размерность массива выгрузки по максимуму
ReDim ArrRes(1 To lRws * 5, 1 To 1)
For j = 3 To 7 ' по нужным "столбцам" массива
For i = 1 To UBound(ArrData) ' по "строкам" массива
If ArrData(i, j) <> Empty Then ' данные есть
' если в первом столбце число, то найденный код пишем в массив выгрузки
' добавляем знак для преобразования чисел в текст
If Val(ArrData(i, 1)) Then k = k + 1: ArrRes(k, 1) = ArrData(i, j) & "_"
End If
Next i
Next j
If k > 0 Then
.Range("I2").Resize(k, 1).Value = ArrRes ' выгружаем все коды на лист
lRws = .Cells(.Rows.Count, 9).End(xlUp).Row ' последняя строка с кодами
' удаляем дубли кодов
.Range("I1:I" & lRws).RemoveDuplicates Columns:=1, Header:=xlYes
End If
End With
Application.ScreenUpdating = True ' включаем обновление экрана
End Sub
Живет он в общем модуле проекта книги. Зайти на разведку в редактор VBA -Alt+F11.