行の挿入ボタン作成、行に番号を付ける

Question

画像の様な表があります。行が足りなくなったら行を挿入するボタンを作成したいと思っています。
条件は以下になります。
・表にはドロップダウンリストなどが組み込まれているのでそれらを残した状態で行を挿入
・１～１０など行の番号を付ける
・インプットボックスで指定の行数を挿入
・１６行目に挿入(もしくは行の番号が付いているセルの下の行）
おまけ
・できれば１度挿入したあと、その下に挿入できるようにしたい

行番号を付けるところでつまづいています。教えてください。
おまけはできたらすごく助かります。宜しくお願いします。

Comments

[hatena19]

現状のコードを提示してください。

[321Kurumins]

Sub 行挿入()
Dim n As Integer
On Error GoTo myError
n = InputBox("挿入する行数を入力して下さい")

If n >= 1 And n <= 100 Then
For i = 1 To n
ActiveCell.EntireRow.Insert xlShiftDown, xlFormatFromLeftOrAbove
Next i
ElseIf n > 100 Then
MsgBox "数値が大きすぎます"
Else
MsgBox "1以上の数値を入力して下さい"
Exit Sub
End If
myError:
MsgBox "キャンセルしました"
End Sub
今はアクティブセルに行を挿入するようにしています。

[hatena19]

質問は編集できるので、質問の方に追記してください。
その際は、コードブロックにしてもらうと読みやすいです。
コードを選択して、エディター上部の <code> をクリックするとコードブロックになります。

[321Kurumins]

ご指摘ありがとうございます。
まだ使い始めたばかりでよくわかってませんでした。
次からそうします！

Answer 1

こんな感じでどうでしょうか。

Sub 行挿入()
    On Error GoTo myError

    Dim n As Long
    n = InputBox("挿入する行数を入力して下さい")

    If n < 1 Then If MsgBox("1以上の数値を入力して下さい") = vbOK Then Exit Sub
    If n > 100 Then If MsgBox("数値が大きすぎます") = vbOK Then Exit Sub

    Dim ws As Worksheet
    Set ws = ActiveSheet

    Dim insRow
    insRow = ws.Range("A1").End(xlDown).Row
   
    ws.Rows(insRow + 1).Resize(n).Insert xlShiftUp, xlFormatFromLeftOrAbove
    ws.Rows(insRow).Resize(2).FillDown
    ws.Cells(insRow + 1, 1).Value = ws.Cells(insRow, 1).Value + 1
    ws.Rows(insRow).Resize(2).AutoFill Destination:=ws.Rows(insRow).Resize(n + 1)
    
    Exit Sub
myError:
    MsgBox "キャンセルしました"
End Sub

Comments

[321Kurumins]

回答ありがとうございます。
テーブル設定せず数式もコピーできました。

Answer 2

シートのデータは下記のようだと仮定してます。

1行目は項目名、2行目からデータ、1列目は行番号

行番号	項目1	項目2	項目3	・・・
1
2
3

行番号の次の空白行にInputBoxで指定した行数を挿入。

Sub 行挿入()
    On Error GoTo myError
    
    Dim n As Long
    n = InputBox("挿入する行数を入力して下さい")

    If Range("A2").Value = "" Then
        Range("A2").Select
    Else
        Range("A1").End(xlDown).Select
    End If
    
    Dim i As Long, s As Long
    s = ActiveCell.Value + 1
    ActiveCell.Offset(1).Select
    
    If n >= 1 And n <= 100 Then
        For i = s + n - 1 To s Step -1
            ActiveCell.EntireRow.Insert xlShiftUp, xlFormatFromLeftOrAbove
            ActiveCell.Value = i
        Next i
        ActiveCell.Offset(, 1).Select
    ElseIf n > 100 Then
        MsgBox "数値が大きすぎます"
    Else
        MsgBox "1以上の数値を入力して下さい"
        Exit Sub
    End If
    Exit Sub
myError:
    MsgBox "キャンセルしました"
End Sub

Comments

[321Kurumins]

ありがとうございます。完璧です。
ただ申し訳ないですが条件をひとつ忘れておりました。
セルに数式が入っている列があります。
数式をコピーして行挿入できますか？

[hatena19]

データ範囲をテーブル化しておくと、挿入すると上の数式を自動でコピーしてくれます。

エクセル 表をテーブルとして書式設定から作成する
https://www.tipsfound.com/excel/06101

[321Kurumins]

そうなんですね。あまりテーブルは使ったことがなかったので
勉強になりました。ありがとうございます。