Public Sub Famille_change()
Dim i As Integer, Derlig As Integer
Dim y As Integer, Lg%, nbLg%, Cel As Range, Tr As Boolean
Me.Sousfamille.Clear
Derlig = Sheets("Adresses").Range("B" & Rows.Count).End(xlUp).Row
For i = 0 To Famille.ListCount - 1
If Me.Famille.Selected(i) = True Then
For Each Cel In Sheets("Adresses").Range("B2:B" & Derlig)
If Cel = Me.Famille.List(i) Then
Lg = Cel.Row
nbLg = Cel.MergeArea.Rows.Count - 1
For y = Lg To Lg + nbLg
Me.Sousfamille.AddItem Sheets("Adresses").Cells(y, 4)
Tr = True
Next y
End If
If Tr Then Exit For
Next Cel
End If
Tr = False
Next i
End Sub