Moving Column Headings

[seendcleeve]

I have a spreadsheet that came from Access

It contains Data in 56 Columns each down to Row 1856

Is it Possible to insert a New Column next to every Column containing the data

And then Copy the Column Heading Where the Data is held into this new Column Down to row 1856 for ever new Column

 

[MichaelRo]

This?:

Sub InsertCol()

Dim icol As Long
Dim irow As Long
Dim strColHeader As String

For icol = 56 To 1 Step -1
    strColHeader = Cells(1, icol)
    Cells(1, icol + 1).EntireColumn.Insert
        For irow = 2 To 1856
            Cells(irow, icol + 1) = strColHeader
        Next
Next

End Sub

 

[erik.van.geit]

Hi, guys,
instead of this loop

        For irow = 2 To 1856 
            Cells(irow, icol + 1) = strColHeader 
        Next

you can code at once

Range(Cells(1, icol), Cells(1856, icol)) = strColHeader

if 1856 can be variable

Dim LR As Long, LC As Long
LR = Cells.Find("*", [A1], xlFormulas, xlPart, xlByRows, xlPrevious, False, False).Row
Range(Cells(1, icol), Cells(LR, icol)) = strColHeader

kind regards,
Erik

 

[seendcleeve]

Thanks Guys been away from my Desk

A