0

誰かがこのループ マクロを手伝ってくれませんか? ループをコピーしたいRange("S16:Y16").Select 3 行下に移動して貼り付け、3 行下に移動して 20 になるまで繰り返します。

エラーは、3行下がってからハングすることです。どんな助けでもいただければ幸いです

サンプルコード

Sub pop1()
    '  Macro
    '
    ' Keyboard Shortcut: Ctrl+f
    '
    Range("S16:Y16").Select
    Selection.Copy
    Range("S19").Select
    ActiveSheet.Paste

    Range("s19:Y19").Select

    For i = 1 To 20
        Selection.Copy
        Range("s19").Offset(3, 0).Select
        ActiveSheet.Paste

        ActiveCell.Offset(3, 0).Select
        ActiveSheet.Paste
    Next i
End Sub
4

4 に答える 4

2

行19の後に20回貼り付けたい場合は、これを試してください

Sub pop1()
    Dim ws As Worksheet
    Dim r As Long

    '~~> Change this to the relevant sheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        r = 19

        For i = 1 To 21
            .Range("S16:Y16").Copy .Range("S" & r)
            r = r + 3
        Next i
    End With
End Sub

編集

上記は値を貼り付けます。すべての形式で貼り付けたい場合は、これを行います

Sub pop1()
    Dim ws As Worksheet
    Dim r As Long

    '~~> Change this to the relevant sheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        r = 19

        For i = 1 To 21
            .Range("S16:Y16").Copy
            .Range("S" & r).PasteSpecial xlPasteAll
            r = r + 3
        Next i
    End With
End Sub
于 2013-04-08T13:50:45.433 に答える
1

保持したい値がその下にない場合にのみ、ループを切り取ってはいけません。それ以外の場合は、他の回答が既に提供されています。

Dim r As Range
Set r = Range("S16:Y16").resize(3)'changed range to include 2 rows bellow 

r(1,1).Offset(R.count, 0).resize(R.count*20).value = R.value

私は携帯電話を使用しているため、構文エラーがある場合はご容赦ください。エラーが見つかった場合は、喜んで修正します。

于 2013-04-08T19:16:59.570 に答える
0

これを試していただけますか？

Sub pop1()
    '  Macro
    '
    ' Keyboard Shortcut: Ctrl+f
    '
    Dim r As Range
    Set r = Range("S16:Y16")
    r.Copy  

    For i = 1 To 20
        r.Offset(3 * i, 0).PasteSpecial
     Next i
End Sub

またはこのミニマリスト：

Sub pop1()
    '  Macro
    '
    ' Keyboard Shortcut: Ctrl+f

  Range("S16:Y16").Copy

    For i = 1 To 20
        Range("S16:Y16").Offset(3 * i, 0).PasteSpecial
    Next i
End Sub
于 2013-04-08T13:48:54.583 に答える