Sub xx()
Dim Plg As Range, TNoms(), LMax&, C&
Set Plg = ActiveSheet.UsedRange
Set Plg = Intersect(ActiveSheet.[11:10000], Plg)
TNoms = Plg.Rows(1).Value
LMax = Plg.Rows.Count + 1
For C = 1 To UBound(TNoms, 2)
Application.Range(Plg(2, C), Plg(LMax, C).End(xlUp)).Name = TNoms(1, C)
Next C
End Sub