复制并粘贴一个范围n次

我想我觉得很简单，但是在search过去几天后还没有find解决scheme。

目标是从这个angular度来看：

abc 1 2 3 4 5 6 

至：

 abcabc abcabc abcabc abcabc abcabc 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 4 5 6 4 5 6 4 5 6 4 5 6 4 5 6 4 5 6 4 5 6 4 5 6 4 5 6 4 5 6 

代码应该find范围的底部和最右边的列，然后复制并粘贴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 eg 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开始，将由空单元格为界限的区域。

我没有覆盖原文，但是如果需要的话，这很容易完成：