エクセルのVBAで指定した行数の追加と数式のコピー方法をご教示いただけますか？

マクロ初心者です。
エクセルで出納帳を作っています。
必要に応じて行を追加挿入する為に、ボタンを作成しそこからアクティブセルのある行の次の行に
行を追加し計算式をコピーするマクロを入れてあります。
（ネットで見つけたコードを参考にしています。）

一行挿入して数式をコピーさせるコードは下記のとおりです。
（挿入ボタンクリック、確認してから行が挿入するようになっています）

列はA列からP列まで使用、
A、B、C、D、H、K、M、N、O、Pの各列に計算式が入っており、挿入した行の各列の数式をコピーさせています。
ちなみに、Eはドロップダウンリストから選択、F、G、I、J列は手入力で必要なデータ等を入力しています。
アクティブセルがある行はセル色が緑になるようになっております。
画像が小さくて見づらいかもしれません。
申し訳ありません。

Sub 追加確認()
If MsgBox("実行してよろしいですか？", vbOKCancel) = vbOK Then
insert_click
End If
End Sub
Sub insert_click()

Sub insert_click()

Application.ScreenUpdating = False
ThisWorkbook.ActiveSheet.Unprotect Password:="0000"

Dim wgyou As Long
wgyou = ActiveCell.Row
If wgyou < 2 Then Exit Sub
Application.CutCopyMode = False
Range(wgyou + 1 & ":" & wgyou + 1).Select
Selection.EntireRow.Insert
Range("A" & wgyou & ":D" & wgyou).Copy
Range("A" & wgyou + 1 & ":D" & wgyou + 1).PasteSpecial Paste:=xlPasteFormulas
Range("H" & wgyou).Copy
Range("H" & wgyou + 1).PasteSpecial Paste:=xlPasteFormulas
Range("K" & wgyou & ":P" & wgyou).Copy
Range("K" & wgyou + 1 & ":P" & wgyou + 1).PasteSpecial Paste:=xlPasteFormulas

Application.CutCopyMode = False
Range("A" & wgyou + 1).Select

ThisWorkbook.ActiveSheet.Protect Password:="0000"

Application.ScreenUpdating = True

End Sub


複数行追加する場合、時間も掛かり一行ずつ追加するのに不便が生じている為
「行挿入ボタン」⇒「挿入の確認」⇒「挿入する行数の指定」⇒「指定した行数を挿入しアクティブセルのある行の数式を挿入した行数分コピーさせる」
ができるコードに変更したいと思っています。

複数行挿入するコードもネットを参照して入れてみましたが
いくら調べても複数行挿入と計算式をコピーさせることができません。

重複しますが、上記のコードを指定した行数分行行を挿入し、数式をコピーさせるように変更させたく思います。

分かりづらい説明で大変申し訳ありませんが、
何卒お力添えいただけますようよろしくお願いいたします。

No.1 回答者： まろはす 回答日時： 2016/01/13 00:18

で？

なにがしたいの？

No.2 回答者： fujillin 回答日時： 2016/01/14 15:26

ご質問文でよくわからないところがありますが・・・

とりあえずこんな感じでしょうか？
（変更というよりは別の形ですが…）

Sub TEST()
　Dim str As String, v As Long
　Dim rng As Range, c As Range

　Set c = ActiveCell
　str = InputBox("挿入行数を入力してください", "行の追加", "1")
　If c.Row > 1 And IsNumeric(str) Then
　　v = Int(Val(str))
　　If v > 0 Then
　　　ActiveSheet.Unprotect Password:="0000"
　　　Set rng = c.Offset(1, 0).Resize(v, 1).EntireRow
　　　c.EntireRow.Copy
　　　rng.Insert
　　　rng.Offset(-v, 0).SpecialCells(xlCellTypeConstants).ClearContents
　　　c.Select
　　　ActiveSheet.Protect Password:="0000"
　　End If
　End If
End Sub

※ ご提示のコードの変更で実現なさりたい場合は、ご提示の内容を指定行数分繰り返すようにすればよろしいかと思います。
　　繰り返しは、例えば For ～～ Next などで実現できます。

この回答へのお礼

fujillinさん
分かりづらい質問ですみません。
まさにやりたいと思っていた通りにできました！
アドバイスいただいたFor～～Nextでもできるよう色々勉強してみます。
有難うございました！

お礼日時：2016/01/14 17:06