Private Sub Worksheet_Activate()
Dim titres&, dest As Range, w As Worksheet, P As Range, h&
titres = 4 'nombre de lignes des titres, à adapter
Set dest = Cells(titres + 1, 1) '1ère cellule de destination
For Each w In Worksheets
If w.Name <> Me.Name Then
Set P = w.UsedRange.EntireRow.Offset(titres): h = P.Rows.Count - titres: If h < 0 Then h = 0
P.Copy dest 'copier-coller
Set dest = dest.Offset(h) 'décale la cellule de destination
End If
Next
dest.Resize(Rows.Count - dest.Row + 1).EntireRow.Delete 'RAZ en dessous
Columns.AutoFit 'ajustement largeur
With UsedRange: End With 'actualise les barres de défilement
End Sub