Loop Insert Column and Function

[exKW258]

Hi, I have a 100+ column spreadsheet. For each column, I have to insert a new column (starting at column "C" to the last column) and fill it with text from the first cell of the column to the right. I use this code to make it work, but I have to copy it 100+ times for each column insert. Is there a way to loop this code?
'-------------------------
Sheets("Cost1").Select
Columns("C:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C2").Select
ActiveCell.FormulaR1C1 = "=LEFT(R1C4,6)"
Selection.AutoFill Destination:=Range("C2:C" & lastrow)
'-------------------------
Thanks for your help.

 

[ParamRay]

.
.

Try this:

Sub InsertColumns()

    Dim intLstCol As Integer
    Dim intColNum As Integer
    Dim lngLstRow As Long
    
    Application.ScreenUpdating = False
    intLstCol = Cells(2, Columns.Count).End(xlToLeft).Column
    For intColNum = intLstCol To 3 Step -1
        lngLstRow = Cells(Rows.Count, intColNum).End(xlUp).Row
        Columns(intColNum).Insert xlToRight
        Range(Cells(2, intColNum), Cells(lngLstRow, intColNum)).Formula = _
            "=LEFT(" & Cells(2, intColNum + 1).Address(False, False) & ",6)"
    Next intColNum
    Application.ScreenUpdating = True

End Sub

 

[exKW258]

Thank you very much. I just need to fix one small thing. I only need to fill the column with data from the first cell. So how do I further limit this statement to only copy/fill text from the first cell of the column "=LEFT($" & Cells(1, intColNum + 1).Address(False, False) & ",6)" Thanks.

 

[exKW258]

Thanks for your help gpeacock. The code works perfectly. I made a slight modification to suit my purposes. Here it is for anyone else who may have a similar request...

"=LEFT($" & Cells(1, intColNum + 1).Address(True, False) & ",6)"