[[20190318234028]]　『VBAでの繰り返し処理について』（ダンガイ）　ページの最後に飛ぶ

『VBAでの繰り返し処理について』（ダンガイ）

[[20190312141756]]　『VBAでの繰り返し処理』（ダンモ）　
『VBAでの繰り返し処理』（ダンモ）
VBAで下記の処理（マクロの記録にて作成）をもっと簡潔に
書けませんでしょうか。
なお、繰り返し処理はA列が空になるまで続けたいです。
よろしくお願いいたします。

（ダンモ）さんのこれに近いのですが、範囲が決まっているため、途中で切れる連続の形です。
B・C・D・E・F・G・Hを下記のように連続させたい。例えば("C31:C174")の範囲
だけで、連続コピーする。すると途中で７の倍数で収まらないことになる。次のセルC175からは、新たにBから始めるというようにしたいのですが、どうでしようか。
なお、この例と異なり、全体の範囲がC29:C297の範囲になります。

    Range("R1:X1").Select
    Selection.Copy
    Range("C31").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    ActiveWindow.SmallScroll Down:=3
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("C31:C174"), Type:=xlFillDefault
    Range("C31:C174").Select

    Range("R1:X1").Select
    Selection.Copy
    Range("C175").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    ActiveWindow.SmallScroll Down:=6
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("C175:C181"), Type:=xlFillDefault
    Range("C175:C181").Select

    Range("R1:X1").Select
    Selection.Copy
    Range("C182").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    ActiveWindow.SmallScroll Down:=9
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("C182:C241"), Type:=xlFillDefault
    Range("C182:C241").Select
    Range("C236:C241").Select
    Selection.Copy

    Range("R1:X1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("C242").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    ActiveWindow.SmallScroll Down:=9
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("C242:C256"), Type:=xlFillDefault
    Range("C242:C256").Select

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

質問がよく理解できないので回答ではないですけど、Selection.○○という書き方が好きではないのでちょっと整理してみました。

    Sub 名もなきマクロ()
        Dim srcRNG As Range
        Dim tmp As Long

        Set srcRNG = Range("R1:X1")
        tmp = srcRNG.Columns.Count

        srcRNG.Copy
        Range("C31").PasteSpecial , Transpose:=True
        Range("C31").Resize(tmp).AutoFill Destination:=Range("C31:C174"), Type:=xlFillDefault

        '↓まちがい？
        'srcRNG.Copy
        'Range("C175").PasteSpecial , Transpose:=True
        'Range("C175").Resize(tmp).AutoFill Destination:=Range("C175:C181"), Type:=xlFillDefault

        srcRNG.Copy
        Range("C182").PasteSpecial , Transpose:=True
        Range("C182").Resize(tmp).AutoFill Destination:=Range("C182:C241"), Type:=xlFillDefault

        srcRNG.Copy
        Range("C242").PasteSpecial , Transpose:=True
        Range("C242").Resize(tmp).AutoFill Destination:=Range("C242:C256"), Type:=xlFillDefault

    End Sub

また、コメントアウトしましたけど、

 Selection.AutoFill Destination:=Range("C175:C181"), Type:=xlFillDefault

↑この部分、オートフィルの対象と出力先がどちらも「Range("C175:C181")」になりませんか？

（もこな２） 2019/03/19(火) 07:31

 ダンガイさん

 私が正しく理解していれば下記でOKです。

 Sub test()
     Dim rng As Range, LR As Long, i As Long
     Const myStep As Long = 144, StartRow As Long = 31
     LR = Range("a" & Rows.Count).End(xlUp).Row
     Set rng = Range("r1:x1")
     For i = StartRow To LR Step myStep
         rng.Copy
         If i + rng.Count > LR Then
             rng.Resize(, LR - i + 1).Copy
             Cells(i, "c").PasteSpecial Transpose:=True
         Else
             Cells(i, "c").PasteSpecial Transpose:=True
             With Cells(i, "c").Resize(rng.Count)
                 .AutoFill .Resize(IIf(i + myStep - StartRow < LR, myStep, LR - i + 1))
             End With
         End If
     Next
 End Sub
（seiya） 2019/03/19(火) 12:08
 修正:貼り付け先範囲がコピー元範囲より小さい時の処理追加 : 12:30

（もこな２）さん(seiya）さん
ありがとうございました。貼り付けることができました。お礼が大変遅くなりましたこともお詫び致します。助かりました。
（ダンガイ） 2019/03/20(水) 11:57

コメント返信：

[ 一覧(最新更新順) ]

[[20190318234028]] 『VBAでの繰り返し処理について』（ダンガイ） ページの最後に飛ぶ

[[20190318234028]]　『VBAでの繰り返し処理について』（ダンガイ）　ページの最後に飛ぶ