excel VBA 複製貼上在同一表單內

excel vba 複製貼上

ncte_cat 2019-08-19 09:42:00 ‧ 17481 瀏覽

分享至

小弟我想要寫一個VBA巨集按鈕。
想寫複製A3:V14內容
然後往下貼上
由於小弟不太會寫迴圈
可以請各位大大麻煩教一下嘛，
例如可以重複十次，
或是到表單100就停止。
複製內容要空三格在往下貼上。
可以請版上的大大請教嗎。
謝謝大大們。

Sub 複製and貼上()
'
' 複製and貼上巨集
'

'
Range("A3:V14").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("A16").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=9
Range("A29").Select
ActiveSheet.Paste
End Sub

來杯拿鐵 iT邦新手 2 級 ‧ 2019-08-19 11:30:42 檢舉

試試看這樣寫
推薦教學(外部網站)
https://blog.gtwang.org/programming/excel-vba-programming-loop/
Sub 複製and貼上()
'
Dim count As Integer '次數
Range("A1").Select

For count = 1 To 10 '1~10次
'你的程式
Selection.Offset(4, 0).Select '往下跳4格(空3格)
Next count

MsgBox "成功"
End Sub

ncte_cat iT邦新手 5 級 ‧ 2019-08-19 11:45:48 檢舉

抱歉大大，我的程式碼只會複製出原本的一組加上複製出來的二組，所以只有三組，重複十次，一樣是三組...
請問大大有甚麼方式可以讓他一直複製原本得下去...
是我說的不清楚，抱歉。
1~10次是希望他能多一到十組出來...麻煩大大了。

來杯拿鐵 iT邦新手 2 級 ‧ 2019-08-19 16:26:14 檢舉

不擅長文字說明的話，
下次用貼示範圖片，
執行前和執行後。

不過你是用錄製巨集嗎？
有出現一些贅句

登入發表討論

直播研討會

{{ item.channelVendor }} {{ item.webinarstarted }} |

直播中

1 個回答

Neish

iT邦研究生 1 級 ‧ 2019-08-19 14:08:27

最佳解答

看不太懂你的描述
文中寫到 複製內容要空三格在往下貼上
可是提供的程式碼是Copy Range("A3:V14")貼到Range("A16")
這樣應該是空一格吧?

我下面實作是以空三格的方式
複製Range("A3:V14")往下貼10次

Sub test()

    Dim i As Integer
    Dim paste_row As Integer
    
    For i = 1 To 10
    
        '貼上的位置
        paste_row = 3 + 15 * i
        
        Range("A3:V14").Copy Range("A" & paste_row)
    
    Next
    
End Sub

https://c-t.work/s/6bee1ed5fb6447

回應 3
分享
檢舉

ncte_cat iT邦新手 5 級 ‧ 2019-08-19 15:10:29 檢舉

有了,謝謝大大。
感謝你

來杯拿鐵 iT邦新手 2 級 ‧ 2019-08-19 17:29:10 檢舉

借我回一下

Sub 巨集()
'初始化
 Dim count As Integer '次數
 Range("A2:E6").Select '選取複製範圍
 Selection.Copy '複製
    
'迴圈程式執行
 For count = 1 To 10 '1~10次

  '選取最下面一格
  Selection.End(xlDown).Select 
  '往下跳4格(空3格)
  Selection.Offset(4, 0).Select 

  ActiveSheet.Paste '貼上
 Next count

 MsgBox "成功"
End Sub