Такой вопрос
Нет варианта из списка автофильтра все значения которые там вытянуть ?
			
		

Function GetUniqueValues(sourceRange As Range) As Variant
    Dim w As Worksheet
    Dim r As Range
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    Set w = Worksheets.Add
    Set r = w.Range("A1")
    sourceRange.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=r, Unique:=True
    r.CurrentRegion.Sort r, xlAscending
    GetUniqueValues = Application.Transpose(r.CurrentRegion.Value)
    w.Delete
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
End Function

Maks the best писал(а):спасибо !!!
слушай, а куда эту функцию засунуть чтоб употребить в работу, скажем мне надо эти значения в столбец D забить ...
Columns(1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns(4), Unique:=True
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 4