Excelで、あるセルの値に応じて行を自動挿入したい

くわしい方、よろしくお願いいたします。

＜したいこと＞
表１のようなデータがあるとします。これをD列の数字に応じて、表2のようにコピー行をその数字の数だけ作りたいのです。もちろん、手作業で「コピー→行挿入」を繰り返せばできますが、いかんせん実際はデータ量が多いため大変です。これを簡単に行う方法はないでしょうか。

表１
　　　A列　　　B列　　　C列　　D列
１　ポテト　　120円　　12/2 3
２　チョコ　　150円　　３/5　 5
３　クッキー　200円　　 5/3 2　


表２
　　　A列　　　B列　　　C列　　D列
１　ポテト　　120円　　12/2 3
２　ポテト　　120円　　12/2 3
３　ポテト　　120円　　12/2 3
４　チョコ　　150円　　３/5　 5
５　チョコ　　150円　　３/5　 5
６　チョコ　　150円　　３/5　 5
７　チョコ　　150円　　３/5　 5
８　チョコ　　150円　　３/5　 5
９　クッキー　200円　　 5/3 2
10 クッキー　200円　　 5/3 2

シートは別に作成されると、なおよいです。

質問者からの補足コメント

• 回答ありがとうございます。さっそく試してみたいと思います。
  
  ただ、時間がかかりそうです。
  もし、よろしければ、エクセルを開いたところからの手順を全く1から指示して頂けないでしょうか。
  ご検討よろしくお願いいたします。

    補足日時：2015/04/15 20:06

No.2 回答者： tom04 回答日時： 2015/04/13 22:33

こんばんは！

一例です。
Sheet1のデータをSheet2に表示するとします。
尚、1行目は項目行で、データは2行目以降にあるとします。

標準モジュールです。

Sub Sample1()
Dim i As Long, wS As Worksheet
Set wS = Worksheets("Sheet1")
With Worksheets("Sheet2")
.Cells.ClearContents
wS.Range("A1").Resize(, 4).Copy .Range("A1")
For i = 2 To wS.Cells(Rows.Count, "A").End(xlUp).Row
With .Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(wS.Cells(i, "D"))
.Value = wS.Cells(i, "A")
.Offset(, 1) = wS.Cells(i, "B")
.Offset(, 2) = wS.Cells(i, "C")
.Offset(, 3) = wS.Cells(i, "D")
End With
Next i
End With
End Sub

※　Sheet2のC列表示形式は日付にしておいてください。m(_ _)m

この回答へのお礼

ありがとうございました。
１さんとはまた違うコードで、こちらはシート２に転写される形式。
こちらも要求通りのことが瞬間でできました。
本当に助かりました。

お礼日時：2015/04/15 20:29

No.1 回答者： hallo-2007 回答日時： 2015/04/13 21:53

VBAの力が必要になりますが、大丈夫でしょうか

表1が　シート名　Sheet1だとして
Sub ボタン1_Click()
For i = 2 To Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
For j = 1 To Sheets("Sheet1").Range("D" & i).Value
GYOU = Range("A" & Rows.Count).End(xlUp).Row + 1
Range("A" & GYOU & ":C" & GYOU).Value = Sheets("Sheet1").Range("A" & i & ":C" & i).Value
Next
Next
End Sub
別シートで実行してみてください。

この回答へのお礼

ありがとうございます。
時間のかかった作業が、一瞬でできました。
助かりました。本当にありがとうございます。

お礼日時：2015/04/15 20:27