VBAで文字入力されている行の上に複数行追加する方法 | 変数で行数指定

エクセルの表を印刷してみるために、見やすくするよう部署ごとに3行の空白を挿入してほしいという要望がありました。他にも方法がありますが、要望通り再現しましたのでその方法を紹介します。

この方法では、A列に部署名が入力されている前提で、各部署ごとにその部署名の上に指定された行数（ここでは3行）の空白行を挿入します。これにより、見栄えの向上や特定のレイアウト要件に対応できます。

VBAでの行挿入の基本

VBAを使用してExcelで行を挿入するには、RowsオブジェクトとInsertメソッドを使用します。

基本

次はアクティブなシート（現在選択されているシート）に行を挿入します。この形式は、アクティブなシートでのみ機能するため、シートを切り替える必要がない場合や、明示的なシートの指定が不要な場合に使用できます。

Rows(挿入位置).Insert

特定のシートに対して行を挿入する場合は、シート名を指定します。異なるシートに対して操作を行う場合や、シートの切り替えが必要な場合に使用します。

対象シート.Rows(挿入位置).Insert

１行挿入をする

2行目の上に新しい行を挿入し、2行目以降のデータが下方向に1行ずつシフトする例です。

Rows(2).Insert

複数行を挿入をする

2行目から5行目の上に新しい行を挿入し、既存のデータを下方向にシフトする例です。

Rows("2:5").Insert

文字が入力されている行の上に複数行挿入する例

データの再利用を考えるのであれば、A列にはこのようにすべて部署名を入力すべきです。しかし、印刷して見やすい表を優先してほしいとのことで、渡されたエクセル一覧は部署名がすべてのセルに入力されていませんでした。

変更前の一覧表

変更前のエクセル一覧表は、その部署の１行目のみに部署名が入力されていました。

変更後の一覧表

部署名の上に３行挿入してほしいという依頼。

実際の一覧表はデータ量が多く、手作業では大変です。

変数で行数を指定して挿入するコード

追加したい行数は、変数で指定する方法です。

２行目の上に挿入した行の書式設定無視

Sub RowsInsert1()
Dim gyo As Long
    Dim i As Long
    Dim lastRow As Long

    gyo = 3                                         '挿入したい行数
    lastRow = Cells(Rows.count, 1).End(xlUp).Row     'A列最終行

    Application.ScreenUpdating = False

    For i = lastRow To 2 Step -1
        If Cells(i, 1).Value <> "" Then
            Rows(i & ":" & i + gyo - 1).Insert
        End If
    Next i

    Application.ScreenUpdating = True
End Sub

この例では、項目名の１行目に書式設定をしていると、挿入した行もその書式設定になります。

２行目の上に挿入した行の書式設定考慮

Sub RowsInsert2()
    Dim gyo As Long
    Dim i As Long
    Dim lastRow As Long
    Dim originalFormat As Range

    gyo = 3                                          '挿入したい行数
    lastRow = Cells(Rows.count, 1).End(xlUp).Row     'A列最終行

    Application.ScreenUpdating = False

    For i = lastRow To 2 Step -1
        If Cells(i, 1).Value <> "" Then
            ' 2行目の書式を保存
            If i = 2 Then
                Set originalFormat = Rows(i).EntireRow
            End If
            Rows(i & ":" & i + gyo - 1).Insert
            ' 2行目の書式を復元
            If i = 2 Then
                originalFormat.Copy
                Rows(i & ":" & i + gyo - 1).PasteSpecial Paste:=xlPasteFormats
                Application.CutCopyMode = False
            End If
        End If
    Next i
    Application.ScreenUpdating = True
End Sub