エクセルで数字を認識して、行をコピーして挿入するマクロ

質問

エクセルのマクロでこんなことは可能でしょうか?

（１）あるセルに(数字)が入ったとき　　　 (そのセルの列は固定）
（２）自動的にそのセルの「行」全体をコピーして
　　　その数字が5なら4行、1なら0行 （入力値より-1行）
（３）ひとつ下の行に「コピーしたセルの挿入」で行の追加をする

例

列 A.B.C.D.E
a.b.c.d.2
"a.b.c.d.2"
a.b.c.d.3
"a.b.c.d.3"
"a.b.c.d.3"

Eの列に2とある場合下に2行-(1行)追加コピー
"a.b.c.d.2"の部分。

無理を言いますが可能であれば
お詳しい方、ご教授宜しくお願い致します。

回答No.3

kigoshi

Ａ列のセルが空欄になるまで全ての行を点検して
Ｅ列のセルに数値が入っていたら、その行の下に
数値－１行コピー挿入するマクロです。

Private Sub CommandButton1_Click()
Const cIdx As Integer = 5 'Ｅ列
Dim rIdx As Long
Do Until rIdx + 1 > Range("A65536").End(xlUp).Row
rIdx = rIdx + 1
If IsNumeric(Cells(rIdx, cIdx).Value) Then
If Int(Val(Cells(rIdx, cIdx).Value)) > 1 Then
Rows(rIdx).Copy
Range(Rows(rIdx + 1), Rows(rIdx + Int(Cells(rIdx, cIdx).Value) - 1)).Insert Shift:=xlDown
rIdx = rIdx + Int(Cells(rIdx, cIdx).Value) - 1
End If
End If
Loop
End Sub

お礼

ありがとうございました

回答No.2

WWolf

こんにちは。
質問の意味がイマイチ理解しにくいのでエラーの事などは考慮していません。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim TR, TC
TR = Target.Row: TC = Target.Column
If TC = 5 Then
TV = Target.Value
Rows(TR).Select
Selection.Copy
Rows(TR + TV - 1).Select
Selection.Insert Shift:=xlDown
End If
End Sub

こういうことでしょうか？

回答No.1

kigoshi

数字が例えば4.6なら4と見なして３行コピーすることにします。

Private Sub Worksheet_Change(ByVal Target As Range)
If IsNumeric(Target.Value) Then
If Target.Column = 5 Then
If Int(Val(Target.Value)) > 1 Then
Rows(Target.Row).Copy
Range(Rows(Target.Row + 1), Rows(Target.Row + Int(Val(Target.Value)) - 1)).Insert Shift:=xlDown
End If
End If
End If
End Sub

でいかがでしょうか。

お礼

ありがとうございます。
できれば
マクロボタンより実行可能にはなりませんか？

補足

質問者です

（１）あるセルに(数字)が入っている時　　　 (そのセルの列は固定）

入ったとき＝まちがい

訂正します。