【VBA】コピー＆複数個所のペースト繰り返し

質問

下記のように、1つの値をコピーし、別シートの複数個所（同じ列の違う行）へ順次ペーストしたいのですが、貼付けデータやペースト箇所が増えた場合でも対応できるようなVBAを教えてください。
よろしくおねがいいたします。

=========================================================
Sub コピペ()

'←1人目をコピー
Worksheets("“コピー元シート”").Range("B7").Select
Selection.Copy
'←貼付け
Worksheets(“貼付シート”).Range("B9", "B37", "B65", "B93", "B121", "B149", "B177").Select
Selection.PasteSpecial Paste:=xlPasteFormulas

'←2人目をコピー
Worksheets("“コピー元シート”").Range("B8").Select
Selection.Copy
'←貼付け
Worksheets(“貼付シート”).Range("B11", "B39", "B67", "B95", "B123", "B151", "B179").Select
Selection.PasteSpecial Paste:=xlPasteFormulas

'←3個の値をコピー
Worksheets("“コピー元シート”").Range("B9").Select
Selection.Copy
'←貼付け
Worksheets(“貼付シート”).Range("B13", "B41", "B69", "B97", "B125", "B153", "B181").Select
Selection.PasteSpecial Paste:=xlPasteFormulas

'←4個の値をコピー
Worksheets("“コピー元シート”").Range("B10").Select
Selection.Copy
'←貼付け
Worksheets(“貼付シート”).Range("B15", "B43", "B71", "B99", "B127", "B155", "B183").Select
Selection.PasteSpecial Paste:=xlPasteFormulas

'←5個の値をコピー
Worksheets("“コピー元シート”").Range("B11").Select
Selection.Copy
'←貼付け
Worksheets(“貼付シート”).Range("B17", "B45", "B73", "B101", "B129", "B157", "B185").Select
Selection.PasteSpecial Paste:=xlPasteFormulas

End Sub

回答No.3

WindFaller · ベストアンサー

#2の回答者です。

> http://okwave.jp/qa/q8534657.html

新しい質問をみましたが、ここの#2のマクロのどこが問題なのでしょうか？

お礼

ご回答ありがとうございました。
私のペーストの場所の修正ミスでコピペがずれており大変申し訳ございませんでした。
おかげ様で、思っていた通りの結果を得ることができました！
こちらのVBAを活用させていただきたいと思っております。
本当にありがとうございました(#^.^#)

補足

ご回答ありがとうございます。
いただいたマクロを実行したところ、B27～、B45～、B63～、B81～にも同じ形式の表があり、そこへのコピペがズレてしまったので再度質問させていただきました。
お手数お掛けいたしますが、よろしくお願い致します。

回答No.2

WindFaller

こんにちは。

>貼付けデータやペースト箇所が増えた場合
具体的な内容がないと、すぐには分からないけれども、一応、人数分が増えるということを想定して作りました。貼り付ける場所は、それぞれの位置に、1行置きに貼り付けるという条件です。

FormulaLocalにしているのは、一般的に、日付式などが入る場合を想定しています。iCOUNT As Long =の所に、人数を入れてください。試してみてください。

なお、まるっきり動かないマクロを掲示されるよりも、細かな情報を与えていただいたほうがよいです。

'//
Sub TestFormulaPaste()
Dim mRanges As Range
Dim i As Long
Const iCOUNT As Long = 5 '人数を入れる

'ペーストの場所
Set mRanges = Worksheets("貼付シート").Range("B9, B37, B65, B93, B121, B149, B177")

For i = 0 To iCOUNT - 1
　mRanges.Offset(i * 2).FormulaLocal = Worksheets("コピー元シート").Range("B7").Offset(i).FormulaLocal 'コピー元の最初の場所
Next i

Set mRanges = Nothing
End Sub
'//

回答No.1

noname#203218

１～５のコピーをする条件を記載しないと回答出来ません。
どういう条件でコピー回数を判断するのでしょうか。

例えば、B9の数式で数値が表示された場合は２箇所コピーする。という事が必要です。

補足

ご回答ありがとうございます。
私の説明が足りず申し訳ございませんでした。
下記URLに画像を添付しましたので、お手数お掛けいたしますが、よろしくお願い致します。
http://okwave.jp/qa/q8534657.html