Bonjour,
Une proposition à étudier.
Cdlt.
Public Sub Create_Names()
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range
Dim lCol As Long, lastCol As Long, lastRow
Set wb = ActiveWorkbook
Set ws = wb.Worksheets("BD")
With ws
lastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For lCol = 2 To lastCol Step 2
Set rng = .Cells(4, lCol).Resize(lastRow - 3, 2)
On Error Resume Next
wb.Names.Add Name:=.Cells(2, lCol).Value, RefersTo:=rng
Next lCol
End With
End Sub
Public Sub Delete_Names()
Dim wb As Workbook, nm As Name
Set wb = ActiveWorkbook
For Each nm In wb.Names
nm.Delete
Next nm
End Sub