マクロでコピーしたセルを4行目毎に挿入する方法

質問

こんにちは！よろしくお願いいたします。
Excel2003で計算式が入力されている1行をコピーして
4行目にコピーしたセルを挿入したいのですが、複数
あるため、マクロを作りたいと思っています。
　　A　　　B　　C
1　氏名　住所　件数　　→　計算式が入力されている
2　氏名　住所　電話
3　氏名　住所　郵便
4　氏名　住所　ふりがな
　　　　　　　　　　　→　1行目の計算式も含めコピーしたい
この操作を繰り返すマクロを作成したいと思っています。
マクロは初心者です。ご指導よろしくお願いいたします。

回答No.5

imogasi

行挿入というアイデアでＶＢＡでプログラムを組むのは、ロジック的に注意が要り、初心者には勧めません。
ＦｏｒＮｅｘｔが旨く簡単に使えないから。
場合によっては下の行から上の行に向かって処理したりしてうまくいくことも有るが。
むしろ原Ａシートと別のシートＢ（最終実現したい・完成したいシート）に
（１）Ａから３行をＢに持ってくる（それもＣｏｐｙよりＡの行の値を代入を勧める。式や書式があればＡよりコピー・Ｂへ貼り付けもやむをえないが）。
（２）次の行に、挿入する１行を持ってくる。
下の行に向かって、（１）－＞（２）を繰り返す。

お礼

回答を頂きありがとうございます。
行の挿入が難しいのは、マクロを編集していてわかりました。

教えて頂いた方法を参考にし、今後も勉強していきたいと思います。
ありがとうございました。

回答No.4

merlionXX

No1の補足に書かれた表をみましたが、8行目、11行目、14行目、17行目でしたら4行ではなく3行おきじゃないですか。もっと正しく書いてくださいよ。
それにNo3まで回答しているのに遡ってNo1のとこころに補足されてもこちらはどれが新しいのか迷ってしまいます。（補足やお礼の欄には日時が表示されません）
苦言ばかりで申し訳ないのですが、まだ疑問があります。
No1の補足でご提示の表では、8行目と11行目にすでに「週平均勤務時間」という行がありますが、8行目、11行目、14行目、17行目～と行を挿入して貼り付けしたいと言ってるわけですから実際には8行目、11行目、14行目、17行目の「週平均勤務時間」の行はまだないということですね？でも5行目だけはコピーするのですから既に存在し、そこに式がはいっているのですね？
実際の表はコードと労働時間の繰り返しで下までずっと続いているのですね？
わかりませんので上記の前提で回答します。
また、「コピーすることによって式の参照元は変わると思いますがそれでいいのですね？」と質問しましたが回答がありませんので、それで良いものとします。
「最終行まで繰り返すとは、エクセルの最後までではなく現在ある表の最終行までですね？」と質問しましたがこれにも回答がありませんので現在ある表の最終行までとします。

こういう、マクロを書く上で必要なことをちゃんと書いてくれないとこちらではわかりませんよ。いくら初心者でもそれくらいのことはわかるでしょ？
気に障ったかと思いますが、yuna21さんが次回からの質問でちゃんと正しい回答が付きやすいようにあえて申し上げました。それ以上の他意はありませんのでご容赦ください。

Sub test04()
Dim Rng As Range '変数宣言
Set Rng = Range("A8") 'A8セルを基点とする
Do Until Rng.Offset(-1).Value = "" 'A列が空白になるまで繰り返し
If (Rng.Row + 1) Mod 3 = 0 Then 'A8セルから3の倍数行目なら
Rng.EntireRow.Insert Shift:=xlDown '行を挿入
Rows(5).Copy Rng.Offset(-1).EntireRow '5行目をコピペ
End If
Set Rng = Rng.Offset(1) '基点を一行下に移動
Loop '繰り返し
Set Rng = Nothing
End Sub

お礼

回答を頂きありがとうございます。
教えてくださったマクロを参考にしながら編集しております。
これだけのマクロができるなんて、素晴らしいです！
まだまだ初心者で、質問も上手く出来ませんでしたが、
これから頑張って勉強に励みたいと思っています。
ありがとうございました。

回答No.3

merlionXX

すみませんが、おっしゃることが理解できません。
最初の表と配列が変わって何がなんだかわかりませんし、この例では途中に式を挿入する意味がわかりません。
いったいどんな表なのでしょうか？

行を挿入したらそれ以降の行は1行繰り下がりますが、それを考慮せずただ現在の5行目を４行おきに行を挿入してペーストすればよいのですね？
またコピーすることによって式の参照元は変わると思いますがそれでいいのですね？
また最終行まで繰り返すとは、エクセルの最後までではなく現在ある表の最終行までですね？
わからないなりに、おっしゃるように書きましたが、まったく自信はありません。

Sub test03()
Dim Rng As Range '変数宣言
Set Rng = Range("A9") 'A9セルを基点とする
Do Until Rng.Value = "" 'A列が空白になるまで繰り返し
If (Rng.Row - 1) Mod 4 = 0 Then 'A5セルから4行の倍数行目なら
Rng.EntireRow.Insert Shift:=xlDown '行を挿入
Rows(5).Copy Rng.Offset(-1).EntireRow '5行目をコピペ
End If
Set Rng = Rng.Offset(1) '基点を一行下に移動
Loop '繰り返し
Set Rng = Nothing
End Sub

回答No.2

merlionXX

No1です。
先ほどのでためしたら途中で終わってしまいますね。
修正しました。

Sub test02()
Dim Rng As Range '変数宣言
Set Rng = Range("A5") '基点
Do Until Rng.Value = "" 'Aが空白になるまで繰り返し
If (Rng.Row - 1) Mod 4 = 0 Then '挿入行確認できたら
Rng.EntireRow.Insert Shift:=xlDown '行挿入
Rows(1).Copy Rng.Offset(-1).EntireRow '1行目をコピペ
End If
Set Rng = Rng.Offset(1) '基点を下に移動
Loop '繰り返し
Set Rng = Nothing
End Sub

補足

ありがとうございます。
せっかく回答を頂いたのに、残念ながら動きません。
私の説明が悪かったと思いますので、もう一度お願いいたします。

　　A　　　B　　C
1　氏名　住所　件数
2　氏名　住所　件数
3　氏名　住所　件数　　
4　氏名　住所　電話
5　氏名　住所　郵便　　　→　計算式が入力されている
6　氏名　住所　ふりがな
7　氏名　住所　ふりがな
8　氏名　住所　ふりがな
9　氏名　住所　郵便　　　→　5行目の計算式も含め1行挿入する

この操作を最終行まで繰り返す

Sub Macro1()
'
　　Rows("5:5").Select
　　Selection.Copy
　　Rows("9:9").Select
　　Selection.Insert Shift:=xlDown
　　Range("A2").Select
End Sub

5行目をコピーし4行目ごとにコピーしたセルを繰り返し
挿入したいのです。

マクロは初心者です。ご指導よろしくお願いいたします。

回答No.1

merlionXX

おっしゃることを誤解しているかもしれませんが、４行おきに単に貼り付けるのではなく行を挿入して貼り付けるのですね？

配置がお書きになった通りであれば以下でいかがでしょうか。

Sub test01()
Dim x As Long, i As Long '変数宣言
x = Cells(Rows.Count, "A").End(xlUp).Row '最終行取得
For i = 5 To x Step 4 '5から4ごとに繰り返す
Rows(i).Insert Shift:=xlDown '行挿入
Rows(1).Copy Rows(i) '1行目をコピペ
x = x + 1 '最終行数加算
Next i '繰り返す
End Sub

補足

早速の回答をありがとうございます。
私の説明が悪くて申し訳ありません。

下記のような表があり、5行目や8行目、11行目の週平均勤務時間には計算式が入っており、この5行目の計算式が入っている行をコピーし、8行目、11行目、14行目、17行目、等の4行下に挿入して繰り返し貼り付けを行いたいです。
よろしくお願いいたします。

　　A　　　　B　　　C　　　　　　D　　　　　　D
1
2　コード 　氏名 勤務時間 　　　2009/03 2009/04
3　123 　A 出勤日　　　　　　　21 16
4 労働時間 　　　　203.67 139
5 週平均勤務時間　　48.7 43.5
6　456　　　B 出勤日 　　　　　20 16
7 労働時間 　　　　176.67 117.34
8 週平均勤務時間 21.5 36.7
9　789 　C 出勤日 　　　　　23 17
10 労働時間 　　　　　179 125.5
11 週平均勤務時間 　39 37