уважаемого Борода творение вроде
а вот и нет)
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 With
End Sub
[/vba]