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(i+1,1)
rng.Clearcontents
end if
Next

--
Regards,
Tom Ogilvy


"Fred" wrote in message
oups.com...
Ok here is what I have:

Columns with several rows of names followed by several rows of numbers,
I need to cut the numbers out, insert a new column and paste them in
the new column. I have tried several things but can't quite get it. I
have many columns to do this with so I need to loop through a range
thanks!!
Fred

BEFO
A B
---------------------
Fred Amy
Dave Jan
Sam Bev
Doug Carol
1 1
2 2
3 3
4 4
5 5
6 6

AFTER:
A B C D
------------------------------------------
Fred 1 Amy 1
Dave 2 Jan 2
Sam 3 Bev 3
Doug 4 Carol 4
5 5
6 6