Sub camembert()
i = 7
Do
If Cells(i, 1) Like "Partie*" Then
t = t & Cells(i, 1) & " contient: " & vbCrLf
i = i + 1
j = 1
Do While Cells(i, 1).MergeCells
t = t & vbTab & "sous-partie" & j & ": " & Cells(i, 1) & vbCrLf
i = i + Cells(i, 1).MergeArea.Rows.Count
j = j + 1
Loop
End If
Loop Until Cells(i, 1) = ""
MsgBox t
End Sub