1.この記事について

こんなケースを想定。
《もともと表があって、それを行と行の間に一行空行を開けた状態の別の表を作りたい。》
《作成した別の表に対して、空行に新しくデータを挿入したい。》

2.やりたいこと

↓このような表が存在するとき。

こんな感じである列のデータの行と行の間に一行空行を開けた表を作りたい。

【用例】
最終的に新しく「産地」列を追加して、産地別のフルーツの価格を管理する。

3.作成したコードと解説

VBAではなく関数で解決（1）

次のような関数を作成。
使用法：もとの表の一番上のデータと同じ行番号に作成する表の一番上のデータを挿入する。

=IF(MOD(ROW(),2) = MOD(ROW($C$3),2),
      INDIRECT(
                        ADDRESS(ROW($C$3) + (ROW()-ROW($C$3))/2,
                        COLUMN($C$3))
                       ),
      "")

※C3セルは元になる表の列（空行を開けたいデータの列）の番地です（詳細は下記の画像をどうぞ）。

MOD(ROW(),2) = MOD(ROW(\$C$3),2)
関数を入力するセルとC3セルの行番号のEven-oddが一致していなければ空欄を返すようにします。

ADDRESS(ROW(\$C\$3) + (ROW()-ROW(\$C\$3))/2,COLUMN(\$C\$3))
ADDRESSで元の表のデータの番地を取得します。
指定する行は、一行空行を開けた場合に入力セルと対応する元の表のセルの番地の行。

実際使用するとこんな感じになります。
（左がもとの表、右が空行開けた新しい表（未完成））

H列の項目列に関数をコピペしています。

VBAではなく関数で解決（2）

おなじみVLOOKUP関数で実装しました。
(1)と異なり少し準備が必要です。

①元の表を用意する。

②先にid列だけコピーした新しい表の骨格を作成する。

③関数を入力する（画像だとM列）。

③で入力する関数に、次のような関数を作成。
使用法：もとの表の一番上のデータと同じ行番号に作成する表の一番上のデータを挿入する。

=IF(MOD(ROW(),2) = MOD(ROW($C$3),2),
     VLOOKUP(
                       (L3 - 1)/2 + 1,
                       $B$3:$C$10,
                       2),
      "")

(1)の関数に比べて、VLOOKUPを使うため可読性は良いかと思います。

VBAの自作関数で解決

これは上記の2ソリューションよりも柔軟性が高いです。

Module_InsertOneRow

'******************************************************************************************
'*関数名    ：insertOneRow
'*機能      ：一行飛ばしで空行挿入
'*引数(1)   ：参照元の範囲
'*引数(2)   ：移動先の表の一番上のデータのセルオブジェクト
'*戻り値    ：True > 正常終了、False > 異常終了
'******************************************************************************************
Public Function insertOneRow(ByVal myRange As Range, _
                             ByVal topCell As Range) As String

    '定数
    Const FUNC_NAME As String = "insertOneRow"

    '変数
    Dim delta As Long                   '一番上のデータのセルと入力セルの行番号の差

    On Error GoTo ErrorHandler
    '戻り値初期値
    insertOneRow = ""

    '---以下に処理を記述---

    '変数の値を取得
    delta = Application.ThisCell.Row - topCell.Row

    'もしdeltaが範囲のセル数以上なら処理を終了
    If delta >= myRange.Count * 2 Then Exit Function

    'もし一番上のデータのセルと入力セルの行番号の差が偶数ならば値を格納する
    If delta Mod 2 = 0 Then
        '戻り値を格納
        insertOneRow = myRange(delta / 2 + 1)
    End If


ExitHandler:

    Exit Function

ErrorHandler:

        MsgBox "エラーが発生しましたので終了します" & _
                vbLf & _
                "関数名：" & FUNC_NAME & _
                vbLf & _
                "エラー番号" & Err.Number & Chr(13) & Err.Description, vbCritical

        GoTo ExitHandler

End Function