Sorry, had a typo:

Sub efg()
Dim lastcol As Long, i As Long, rng As Range
lastcol = Cells(1, "IV").End(xlToLeft).Column
For i = lastcol To 1 Step -1
Columns(i + 1).Insert
Set rng = Nothing
On Error Resume Next
Set rng = Columns(i).SpecialCells(xlConstants, xlNumbers)
On Error GoTo 0
If Not rng Is Nothing Then
rng.Copy Cells(1, i + 1)
rng.ClearContents
End If
Next

End Sub

--
Regards,
Tom Ogilvy

"Fred" wrote in message
ups.com...
Thanks Tom... the columns insert fine but the numbers do not move they
just disappear... any ideas?
Fred