Private Sub Worksheet_Activate()
Dim lig&, w As Worksheet, h&
lig = 6 '1ère ligne de destination
Application.ScreenUpdating = False
Rows(lig & ":" & Rows.Count).Delete xlUp 'RAZ
For Each w In Worksheets
If w.Name <> Me.Name And UCase(w.Name) <> "MENU" Then
With w.Range("B5").CurrentRegion.EntireRow
h = .Rows.Count
If h > 1 Then
.Rows(2).Resize(h - 1).Copy Cells(lig, 1) 'copier-coller
lig = lig + h - 1
End If
End With
End If
Next
With [B5].CurrentRegion
.Borders.Weight = xlThin
.BorderAround Weight:=xlMedium 'contour
.Rows(1).BorderAround Weight:=xlMedium
End With
End Sub