iT邦幫忙

0

VBA 不同工作表重複貼上

Jamie 2020-10-22 13:28:5110367 瀏覽
  • 分享至 

  • xImage

Hi all,

想請問各位大師,今天我有一個a工作表與b工作表想進行合併複製貼上,想要的流程如下:
我想將b工作表的C欄位逐步複製到a工作表的b欄位(都從第二列開始),而且b欄位需重複複製300個。
似乎要用雙迴圈,但我寫不出來@@",想請教各位大師。
範例:
1.工作表a C2複製
工作表b B欄位連續貼上300個C2
2.工作表a C3複製
工作表b 從上面接續B欄位繼續貼上300個C3
3.以此類推。

akissiva iT邦新手 5 級 ‧ 2020-10-23 10:11:20 檢舉
很好奇,都是同一個C2,為什麼要重複貼300次??

複製一次C2→選取想貼的300個B欄→在選好的範圍按右鍵貼上,就可以把一個C2一次貼在300個B欄了,不是嗎?
圖片
  直播研討會
圖片
{{ item.channelVendor }} {{ item.webinarstarted }} |
{{ formatDate(item.duration) }}
直播中

1 個回答

0
海綿寶寶
iT邦大神 1 級 ‧ 2020-10-22 15:15:56
最佳解答

以下程式預定從 C2 複製到 C6

Option Explicit
Const kRowCount = 300
Sub Main()
    Dim nI
    For nI = 2 To 6
        OneCopy (nI)
    Next nI
End Sub
Sub OneCopy(ByVal pIdx As Integer)
    Dim nRowBegin, nRowEnd
    
    nRowBegin = 2 + (pIdx - 2) * kRowCount
    nRowEnd = nRowBegin + kRowCount - 1
    
    Sheets("SheetB").Select
    Range("C" & pIdx).Select
    Selection.Copy
    
    Sheets("SheetA").Select
    Range("B" & nRowBegin).Select
    ActiveSheet.Paste
    
    Range("B" & nRowBegin & ":B" & nRowEnd).Select
    Selection.FillDown
End Sub

另外,點這裡是我這次鐵人賽唯一的一篇文章,喜歡的話左上角點 Like

race iT邦新手 5 級 ‧ 2020-10-26 09:31:56 檢舉

可以運用Range.Resize方式給值,會看起簡單些

Sub test()
    Dim rngChk as Range
    Dim rngFin as Range
    Dim i%
    Dim shtA as WorkSheet
    Dim shtB As WorkSheet
    
    Set shtA = WorkSheets("SheetA")
    Set shtB = WorkSheets("SheetB")
    set rngChk = shtB.Range([C2],[C2].End(xlDown))
    set rngFin = shtA.[B2]
    Application.ScreenUpdate = False
    For i = 0 to rngChk.count - 1
        rngFin.offset(i).resize(,300)=rngChk(i+1).value
    next
end sub

我要發表回答

立即登入回答