列ごとに複数列追加するマクロ

何度か使いそうな用件があったので、作ってみた。

選択した列範囲に指定した行数追加していくexcel用vbaマクロ

Sub 列を追加する()
'選択列の後ろに指定数挿入

Dim N As Integer
Dim startC, endC, currentC As Long
Dim LoopCount As Long
Dim i As Long
Dim LoopArea As Range
Dim SelectArea As String

SelectArea = Selection.Address
Set LoopArea = Selection

'挿入したい列数を
N = 3

'状況取得
startC = LoopArea.Cells(1).Column
endC = LoopArea.Cells(LoopArea.Count).Column

'挿入処理
LoopCount = endC - startC + 1
currentC = startC

'画面描画抑止
Application.ScreenUpdating = False

For i = 0 To (LoopCount - 1)
    With ActiveSheet
        .Range(.Columns(currentC + 1), .Columns(currentC + N)).Insert
    End With
    currentC = currentC + N + 1
Next

'画面描画の再開
Application.ScreenUpdating = True

End Sub