Question

我想我认为非常简单，但在搜索过去几天之后找不到解决方案。

目标是从这里开始：

a b c
1 2 3
4 5 6

要：

代码应该找到范围的底部和最右边的列，然后在没有msg框的情况下复制和粘贴10次。

以下是代码，但它只复制第一行：

Sub test()
Dim n As Integer, rng As Range
'n = InputBox("type the value of n")
Set rng = Range("a1")
rng.Select
line2:
n = InputBox("type no. of times you want to be repeated minus 1 for e.g if you wnat to be repeated 3 times type 2")
Range(rng.Offset(1, 0), rng.Offset(n, 0)).EntireRow.Insert
Range(rng, rng.End(xlToRight)).Copy
Range(rng, rng.Offset(n, 0)).PasteSpecial
Set rng = rng.Offset(n + 1, 0)
If rng = "" Then
GoTo line1
Else
GoTo line2
End If
line1:
Application.CutCopyMode = False
Range("a1").Select
MsgBox "macro over"

End Sub

非常感谢任何帮助。

Answer 1

试试这个：

Sub RepeatRange()
    Dim rng() As Variant, rows As Long, n As Integer, i As Long

    rng = Range("A1").CurrentRegion

    n = InputBox("type no. of times you want to be repeat the range")

    For i = 1 To UBound(rng)
        Range("A" & (n * i) - (n - 1) & ":A" & n * i).Value = rng(i, 1)
        Range("B" & (n * i) - (n - 1) & ":B" & n * i).Value = rng(i, 2)
        Range("C" & (n * i) - (n - 1) & ":C" & n * i).Value = rng(i, 3)
    Next i
End Sub

Answer 2

如果我理解正确的话，试试这个：

Option Explicit
Sub CopyRpt()
    Const lNumRepts As Long = 10 '<--change as required
    Dim rSrc As Range, rRes As Range, RW As Range

'Results to start in row two below the Source Data
Set rRes = Range("a1").End(xlDown).Offset(rowoffset:=2)

Set rSrc = Range("a1").CurrentRegion
'Copy each row in Source Data to Results range
For Each RW In rSrc.Rows
    RW.Copy rRes.Resize(rowsize:=lNumRepts)
    Set rRes = rRes.Offset(rowoffset:=lNumRepts)
Next RW
End Sub

请注意，CurrentRegion将是从A1开始的区域，该区域将由空单元格限定。

我没有覆盖原文，但如果需要可以轻松完成：

复制并粘贴范围n次

2 个答案: