セルに入力されている数値に応じて行を挿入

Question

初めて質問いたします。
よろしくお願いいたします。

過去の下記リンク質問と同様のことをしたく、ご回答いただいていた内容で分からないなりに試行錯誤してみましたが、データのある最終行だけコピーと挿入がされません。

ご教示のほどよろしくお願いいたします。

リンク内容

Comments

[meg_]

> ご回答いただいていた内容で分からないなりに試行錯誤してみましたが
そのコードを質問に追記してください。

質問者さんの実行環境も質問に追記してください。

[w.u]

ご返信ありがとうございます。
急ぎ対応したく、多くの方をフォローさせていただいたことが原因か、アカウント凍結となってしまったため、こちらからお礼だけさせていただきます。遅くなり大変申し訳ございません。ありがとうございます。

Answer 1

これでどうでしょうか。

Sub sample()
    Dim rng As Range, i As Long, r As Long
    For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
        r = Cells(i, 2).Value
       'If r = 0 Then r = 1
        Rows(i + 1).Resize(r).Insert
        Rows(i).Resize(r + 1).FillDown
    Next
End Sub

Comments

[w.u]

ご返信ありがとうございます。
急ぎ対応したく、多くの方をフォローさせていただいたことが原因か、アカウント凍結となっておりますので、こちらからお礼をさせていただきます。
ありがとうございます。
後ほどテストとともに改めて勉強させていただきます。