Private Sub CommandButton1_Click()
Dim P As Range, h&, Q As Range, cle$, c As Range
Set P = [A1].CurrentRegion.Offset(1).Resize(, 13)
h = P.Rows.Count
P.Columns(14).ClearContents 'RAZ
P.Interior.ColorIndex = xlNone 'RAZ
Set Q = Intersect(P.Rows(0), Selection)
If h = 1 Or Q Is Nothing Then Exit Sub
cle = """"""
For Each c In P.Rows(0).Cells
If Not Intersect(c, Q) Is Nothing Then cle = cle & "&" & c(2).Resize(h).Address
Next
P.Columns(14) = Evaluate(cle)
Intersect(P.Resize(h - 1), Q.EntireColumn).Interior.ColorIndex = 24
End Sub