Sub TabFusionFeuilles(Tr())
Dim Te(), Le&, Ts(), Ls&, C&, F As Worksheet, Ville
ReDim Ts(1 To 5, 1 To 2000)
For Each F In ThisWorkbook.Worksheets
Ville = F.[A1].Value
If Ville <> "" Then
Te = ColUti(F.[E4:H4]).Value
For Le = 1 To UBound(Te)
Ls = Ls + 1: For C = 1 To 4: Ts(C, Ls) = Te(Le, C): Next C
Ts(5, Ls) = Ville: Next Le: End If: Next F
ReDim Preserve Ts(1 To 5, 1 To Ls)
Tr = WorksheetFunction.Transpose(Ts)
End Sub
Sub Essai()
Dim T()
TabFusionFeuilles T
ActiveSheet.[B5].Resize(UBound(T), 5) = T
End Sub