Howard,

This macro worked for me:

Sub CreateNames()
Dim rData As Range
Dim lNames As Long
Dim rNames As Range
Dim sError As String

Set rData = Sheet1.Range("B1,F1,K1")
Set rNames = Sheet1.Range("A1")

For lNames = 0 To 4

On Error Resume Next
ThisWorkbook.Names.Add Name:=rNames.Offset(lNames, 0), RefersTo:= _
"=" & rData.Offset(lNames, 0).Address
If Err.Number < 0 Then
sError = sError & vbCr & rNames.Offset(lNames, 0)
Err.Clear
End If

Next lNames

If Len(sError) 0 Then MsgBox "The following names could not be added: " & _
vbCr & sError, vbExclamation, "Check names"


End Sub