création d'une clé unique via userform

Dim P As Range 'mémorise la variable

Private Sub UserForm_Initialize()
Set P = [A1].CurrentRegion.Offset(1).Resize(, 13)
ListBox1.List = Application.Transpose(P.Rows(0))
End Sub

Private Sub CommandButton1_Click()
Dim cle$, col%
cle = """"""
For col = 1 To P.Columns.Count
  If ListBox1.Selected(col - 1) Then cle = cle & "&" & P.Columns(col).Address
Next
P.Columns(14) = Evaluate(cle)
End Sub

Private Sub CommandButton2_Click()
P.Columns(14).ClearContents
UserForm_Initialize
End Sub

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 Q
  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

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