[英]Copy and paste a range n times
我想我覺得很簡單,但在搜索了過去兩天后仍未找到解決方案。
目標是從此出發:
a b c
1 2 3
4 5 6
至:
a b c
a b c
a b c
a b c
a b c
a b c
a b c
a b c
a b c
a b c
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
代碼應找到范圍的底部,並在右側找到最遠的列,然后在沒有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
任何幫助將非常感激。
嘗試這個:
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
如果我對您的理解正確,請嘗試以下操作:
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開始的區域,該區域將由空單元格限制。
我沒有覆蓋原始文件,但是如果需要,可以輕松完成:
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.