Sub ConstruireTable()
Dim wst As Worksheet, i As Long
Application.ScreenUpdating = False
i = 1
With Sheets("table")
.Range("a:e").Clear
.[A1] = "Région:"
.[B1] = "Province:"
.[C1] = "Commune:"
.[D1] = "Arrondissement:"
.[E1] = "Secteur\Village:"
For Each wst In WorkSheets
If wst.Name <> .Name Then
i = i + 1
wst.Range("B1:B5").Copy
.Range("A" & i).PasteSpecial Paste:=xlPasteAll, Transpose:=True
End If
Next wst
End With
Application.ScreenUpdating = True
End Sub