уважаемого Борода творение вроде
а вот и нет)
Sub Мяу()
может быть только у RAN
[vba]
Sub Мяу() Dim i&, k&, r As Range With ActiveSheet.ListObjects("Таблица1").AutoFilter k = .Range(1).Column .Range.FormatConditions.Delete For i = 1 To .Range.Columns.Count If .Filters(i).On Then ' выделяется весь столбец ' Set r = Intersect(.Range, ActiveSheet.Columns(i + k - 1)) Set r = Intersect(.Range.Rows(1), Columns(i + k - 1)) r.FormatConditions.Add Type:=xlExpression, Formula1:="=СТОЛБЕЦ()=" & i + k - 1 r.FormatConditions(1).Interior.Color = 255 Set r = Nothing End If Next End WithEnd Sub
[/vba]