Private Sub Worksheet_Activate()
Dim lig&, w As Worksheet, P As Range, derlig&
Application.ScreenUpdating = False
Rows("10:" & Rows.Count).Delete 'RAZ
lig = 10
For Each w In Worksheets
If w.Name <> Me.Name Then
Set P = Intersect(w.Rows("10:" & Rows.Count), w.UsedRange.EntireRow)
If Not P Is Nothing Then
P.Copy Cells(lig, 1)
lig = lig + P.Rows.Count
End If
End If
Next
derlig = Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
If derlig > 11 Then
Set P = Range("D10", Cells(derlig - 2, 4))
On Error Resume Next 'au cas improbable où aucune cellule n'est vide
P.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
P.EntireRow.Sort P, xlAscending, Header:=xlNo 'tri facultatif
End If
End Sub