[[20190906141611]]　『VBAで１５行ごとにセルのコピーを繰り返したい』（きり）　ページの最後に飛ぶ

『VBAで１５行ごとにセルのコピーを繰り返したい』（きり）

 Macro4 Macro
'
    Selection.Copy
    ActiveWindow.SmallScroll Down:=15
    Range("B32").Select
    ActiveSheet.Paste

End Sub

B15に入力されているデータを
B10,000まで同じデータを繰り返したい
B15に入力されているデータはセルが結合されており
書式ごと15行おきに貼りつけたい
よろしくお願いいたします

＜使用 Excel：Office365、使用 OS：Windows10 ＞

Sub test()

    Dim i As Long

    Range("A1:A2").copy
        For i = 14 To 10000 Step 15
            Range("A1").Offset(i, 0).PasteSpecial Paste:=xlPasteAll
        Next

End Sub

最初のコピーのみ結合部分まるごと指定し、あとはForループ＋ステップで繰り返すのはいかがでしょう。
開始時の移動距離は、変数iの数値で調整しています。

原初的なやり方なのでもっと良いやり方があれば。。。
（れっきゅん） 2019/09/06(金) 15:19

＞B15に入力されているデータを（中略）書式ごと15行おきに貼りつけたい
だとB31に貼り付けることになりそうですが、
＞B15に入力されているデータはセルが結合
ということで、実はB15:B16という感じで結合されていて間を15行あけるということなんでしょうか？

ちょっと前提が飲み込めてないので、難しく考えすぎているのかもしれませんが、こんな感じとか？

    Sub さんぷる()
        Dim 間 As Long
        Dim i As Long
        Dim buf As Range

        With Range("B15")

            間 = 15 + .MergeArea.Rows.Count

            For i = 間 - 1 To 10000 - 間 Step 間
                If buf Is Nothing Then
                    Set buf = .Offset(i)
                Else
                    Set buf = Union(buf, .Offset(i))
                End If
            Next i

            .MergeArea.Copy buf
        End With

    End Sub

（もこな２） 2019/09/06(金) 17:43

もこな２様
B15に文字を入力しています
B15に入力している書式も含めてすべて
15行間隔で貼りつけたいのです
わかりにくくて済みません　10,000行まで貼りつけるので
VBAで対応したいのです
お手数かけます
（きり） 2019/09/06(金) 18:04

いや、分からないのはこの部分です。
＞B15に入力されているデータを（中略）15行おきに貼りつけたい

結合を抜きにして考えると、
　(1)間に15入れたいのであれば・・・・B15、B31、B47....
　(2)15行おきにというのであれば・・・B15、B30、B45....
となるから、何故、B32に貼付しているのか分からないのです。

そのうえで、B15：B16が結合されていて間に15行入れたいのであれば
15～16　－　間に15行　-　32（～33)で辻褄があうので、そういうことなのか確認しているのですが・・・
提示したものでは、そのように解釈して答えてみましたが違いましたか？

（もこな２） 2019/09/06(金) 18:33

（もこな２）様
(2)15行おきにというのであれば・・・B15、B30、B45....です

B32は間違えです
混乱させてすみません

貼り付け先もセルが結合しており
ちなみに.MergeArea.Copy bufが「この操作は結合したセルには使えませんと出ます」
解決策がありますか
（きり） 2019/09/06(金) 18:48

＞「この操作は結合したセルには使えませんと出ます」
それは、貼付先が既に結合されているからですね。
試すなら、30行目以下の全セルを削除するか、セル結合を解除してから試してください。

ちなみに、B15は実際にはどう結合されているのですか？

（もこな２） 2019/09/06(金) 19:00

もこな2様
b15：b16と結合されています
コピー先もb30:b31と結合されています
コピー先は結合を解除しないと無理なのですね
前任者が作った書式で他にも複数の箇所が結合して作成してあるので
困ったなと思っていました
貼り付け先の結合を解除すると15行おきにコピーできましたが1万行まであるので
困ったなと思っています
請求書領収書入金伝票の書式に
簡易課税である事を15行ごとに今の書式を使って簡単に表記できないかなと考えておりました
初心者が甘えてすみません

（きり） 2019/09/06(金) 19:40

＞b15：b16と結合されています
＞コピー先もb30:b31と結合されています
それだと、ちゃんとやれば提示の提示のエラーは出ないと思うので、行数の増加を修正しないまま（私が提示したまま）で、試して行がずれてたんじゃないですか？

とりあえず、貼付先が　B30:B31,B45:B46,B60:B61....ってことがわかったので修正。
ついでに、貼付先のにセル結合があった場合は解除しちゃうようにしておきました。

    Sub さんぷる弐()

        Dim i As Long
        Dim buf As Range, MyRNG As Range

        '▼貼付先のセルを覚える
        Set buf = Range("B30")
        For i = 45 To 10000 Step 15
            Set buf = Union(buf, Cells(i, "B"))
        Next

        '▼覚えたセルの集まりから1つずつ取り出して、セル結合されていれば解除
        For Each MyRNG In buf
            MyRNG.MergeArea.UnMerge
        Next

        '▼B15を含む結合範囲を、覚えたセルに一気に貼付
        Range("B15").MergeArea.Copy buf

    End Sub

（もこな２） 2019/09/07(土) 02:13

ものな2様
おかげさまで、時間をかけず仕事が出来ました
ありがとうございました

（きり） 2019/09/07(土) 17:32

コメント返信：

[ 一覧(最新更新順) ]

[[20190906141611]] 『VBAで１５行ごとにセルのコピーを繰り返したい』（きり） ページの最後に飛ぶ

[[20190906141611]]　『VBAで１５行ごとにセルのコピーを繰り返したい』（きり）　ページの最後に飛ぶ