Private Sub Worksheet_Activate()
Dim deb&, lig&, w As Worksheet, i As Variant, h&
Application.ScreenUpdating = False
deb = 9 '1ère ligne de destination, modifiable
Rows(deb & ":" & Rows.Count).Delete 'RAZ
lig = deb
For Each w In Worksheets
If w.Name <> Me.Name Then
i = Application.Match("Commentaires", w.Columns(1), 0)
If IsNumeric(i) Then
h = w.UsedRange.Rows.Count - i + 1 'ligne de titre comptée
If Application.CountA(w.Cells(i, 1).Resize(h)) > 1 Then
Cells(lig, 1) = w.Cells(4, 1) 'titre
Cells(lig, 1).Font.Bold = True 'en gras
lig = lig + 2
w.Cells(i + 1, 1).Resize(h - 1).Copy Cells(lig, 1)
lig = lig + h
End If
End If
End If
Next w
'---supprime les lignes vides excédentaires---
For lig = lig To deb + 1 Step -1
If Cells(lig, 1) & Cells(lig - 1, 1) = "" Then Rows(lig).Delete
Next lig
End Sub