Sub Synthese()
Dim T(), x As Long, i As Integer, DerL As Long
For i = 2 To Worksheets.Count
With Worksheets(i)
If WorksheetFunction.CountA(.Range("B13:B32")) > 0 Then
x = x + 1
ReDim Preserve T(1 To 22, 1 To x)
T(1, x) = .Range("E5")
T(2, x) = .Range("E7")
T(3, x) = .Range("B7")
T(4, x) = .Range("B5")
T(8, x) = .Range("B33")
T(9, x) = .Range("B34")
T(10, x) = .Range("B35")
T(12, x) = .Range("B37")
T(15, x) = .Range("C33")
T(16, x) = .Range("C34")
T(17, x) = .Range("C35")
T(20, x) = .Range("D33")
T(21, x) = .Range("D34")
T(22, x) = .Range("D35")
End If
End With
Next
With Worksheets("SYNTHESE")
DerL = .Range("B" & Rows.Count).End(xlUp).Row + 1
If x > 0 Then .Range("B" & DerL).Resize(UBound(T, 2), UBound(T, 1)) = Application.Transpose(T)
End With
End Sub