Adding 6 columns after each Column with a header

[Chris McGlothen]

I am having some issues trying to insert 6 columns after each column with a header. I have tried several different VBA's and tried creating a macro, but the macro seems to fail after so many entries. I have attached an example. I would like to have it insert 6 columns starting with column "K" and continue to Column "S". Any help would be greatly appreciated. Thanks,

[nilem]

Hi Chris McGlothen,
try it

Sub ttt()
Dim i&
For i = 19 To 12 Step -1
    Columns(i).Resize(, 6).Insert Shift:=xlToRight
Next
End Sub

[Arkadi]

Give this a try:

Option Explicit
Sub add_columns()

Dim ws As Worksheet
Dim lc As Long
Dim fc As Long
Dim i As Long

Set ws = ThisWorkbook.Worksheets("Sheet1") 'adjust sheet name as needed
fc = 11 'first column that we want to insert columns after
'find last column.... if you just always want column S, then make lc = 19
lc = ws.Cells(1, Columns.Count).End(xlToLeft).Column
For i = lc To fc Step -1
    'if there is a header, insert 6 columns
    If ws.Cells(1, i).Value <> vbNullString Then ws.Cells(1, i).Offset(, 1).Resize(, 6).EntireColumn.Insert
Next i

End Sub

[Chris McGlothen]

Thank you both! These both worked great!!!

[MarvinP]

How about another?

Sub InsertColumns()
    Dim ColCtr As Double
    For ColCtr = 19 To 11 Step -1
        Range(Cells(1, ColCtr), Cells(1, ColCtr + 5)).EntireColumn.Select
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Next ColCtr
End Sub

The secret is to insert from the right to the left using the Step - 1 in the For..Next loop.