Dim ws As Worksheet Dim r As Range Dim ID() As String Set ws = ThisWorkbook.Worksheets(2) kolcells = ThisWorkbook.Worksheets(2).Cells(1, 1).End(xlDown).Row 'оставляем только уникальные значения Set r = ws.Range("A1:A" + CStr(kolcells)) r.AdvancedFilter Action:=xlFilterInPlace, Unique:=True 'кидаем в массив ICells = 1 ReDim ID(kolcells) For Each rw In r.Rows If Not rw.Hidden Then Debug.Print rw.Cells(1).Text ID(ICells) = rw.Cells(1).Text ICells = ICells + 1 End If Next For ICells = 1 To kolcells Debug.Print ID(ICells) Next 'убираем филтр ws.ShowAllData