Sub Lit_Adrs()
Dim Tbl As Range, Adrs As Range
Dim Ligne As Long, Ligne_Encour As Long
Dim Adresse_Mail As String
Dim Col As Byte
Set Tbl = ActiveSheet.UsedRange
Col = Tbl.Columns.Count
Ligne = Tbl.Rows.Count
For Each Adrs In Tbl
If Adrs.Column = 3 Then
Ligne_Encour = Adrs.Row
If Ligne_Encour < Ligne Then
Adresse_Mail = Adresse_Mail & Adrs & ';'
Else
Adresse_Mail = Adresse_Mail & Adrs
End If
End If
Next Adrs
ThisWorkbook.FollowHyperlink Address:='mailto:' & Adresse_Mail
End Sub