Try this, it doesn't result in the dynamic ranges  you may be looking
for but it correctly deals with any gaps in columns and any gaps in
rows, which CountA doesn't:

Sub blah()
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
For x = 1 To lastcol
lastrow = Cells(Rows.Count, x).End(xlUp).Row
If Cells(1, x) <> "" Then
With ActiveWorkbook.Names
.Add Name:=Cells(1, x).Value, _
RefersTo:="=Sheet1!" & Range(Sheets("Sheet1").Cells(2, x), _
Sheets("Sheet1").Cells(lastrow, x)).Address
End With
End If
Next x
End Sub

Thanks for this! I managed to modify it so that it had the desired
effect. I have another similar issue...

One of the named  ranges i've generated contains a number  of cells
that have embedded shape objects in them. What I can't figure out is
how to copy the objects from this named range  into another named
range.

It works fine using Ctrl-C Ctrl-V on the keyboard, but using VBA

range("abc").value = range("xyz").value
or
range("abc").Copy Destination:=Range("xyz")

both fail to copy the objects. Amy i missing something obvious?

range("B10:F10").Copy Destination:=Range("B17")

worked, but seemed to depend on how much or which parts of the object
overlapped the cells  selected for copying. If the objects were
completey within the selection copying was fine. Control Toolbox
toolbar objects were not copied, however, Forms toolbar objects were.

i still can't get it working using named  ranges, but the following
seems to get the job done, so i guess it'll do!

Application.CutCopyMode = False
Sheets("Source").Columns("C:C").Copy
Sheets("Destination").Columns("K:K").Select
ActiveSheet.Paste