Sub conso()
Set synt = Sheets("synthèse")
synt.[A2:I10000].ClearContents
For s = 2 To Sheets.Count
ligne = synt.[A1].CurrentRegion.Rows.Count + 1
ncol = Sheets(s).[A1].CurrentRegion.Columns.Count + 1
For t = 1 To ncol
titre = Sheets(s).Cells(1, t)
Set result = synt.Rows(1).Find(what:=titre)
If Not result Is Nothing Then
ligne2 = Sheets(s).[A1].CurrentRegion.Rows.Count + 1
Sheets(s).Range(Sheets(s).Cells(2, t), Sheets(s).Cells(ligne2, t)).Copy synt.Cells(ligne, result.Column)
End If
Next t
Next s
End Sub