【VBA】Excelで１行ずつ間に行を挿入する

2022年1月27日2022年4月30日

Excelで一覧表を作成した後に、「１行１行、間に空白行を挿入する」
なぁんて言う作業が加わったりしませんか？
今回はその「１行１行、間に空白行を挿入する」を、
例題を用いてVBAで自動化をしたいと思います。
　

例題とサンプルコード

今回の例題は
　・セルB2を左上端、２行目を表の見出しとし、
　・最下段を12行目とした表に
　・各１行１行の間に空白の行を挿入する
としてみます。

Dim i As Long

 For i = 12 To 4 Step -1
  Rows(i).Insert
 Next i

サンプルコードでは、【For Next】のループ機能を用いて
昇順ではなく、降順、つまり最終行から挿入をスタートさせています。
この遡って降順で処理する事で、コードがシンプルに書けます。
もしも行数が違っていたら、上のコードを

[For i = 12 To 4 Step -1] を
[For i =（最終行）To（最初に行を挿入する位置）Step -1]

と適宜修正してください。

数行の挿入ならば手動でやっても早いですが、
何十行、何百行あるとVBAでの処理が断然効率的です。
※↑のコードでは最終行には挿入されません。

応用のコード

続いては発展した形のVBAコードを記します。
↑のサンプルコードよりもより実践的なコードになっていると思います。

このコードでは
・画面のように２行目が表の見出し行で
・セルB3から内容がスタートとする事が前提ですが、以下の事が可能です。

１．最終行を自動で計測してくれる。
２．最終行にも空白行を挿入してくれる

Dim i, EndLine1, StartLine1 As Long
 
'Screen_Stop
Application.ScreenUpdating = False

 If Range("B3").Value <> "" Then  '表の左上端がB2とした場合
  StartLine1 = 3
  EndLine1 = Range("B2").End(xlDown).Row
 
  For i = EndLine1 To StartLine1 + 1 Step -1
   Rows(i).Insert
  Next i

'最終行も空白行を挿入する
  i = EndLine1 - StartLine1 + 1
  Rows(StartLine1 + 1).Copy
  Rows(EndLine1 + i).Insert

  Application.CutCopyMode = False
 End If

'Screen_Restart
Application.ScreenUpdating = True

上のコード [If Range(“B3”).Value <> “” Then] 部分の
B2がリストの見出し行であり、B3から内容がスタートする場合のコードです。仮に見出し行がＡ１(１行目)であり、Ａ２から内容がスタートするのであれば、
[If Range(“A2”).Value <> “” Then] で、内容のスタート位置もズレますので
[StartLine1 = 2] としてください。
加えて、[EndLine1 = Range(“B2”).End(xlDown).Row] も
[EndLine1 = Range(“A1”).End(xlDown).Row] と適宜修正する必要があります。

以上になります。
参考になれば幸いです。