VBA 不同工作表重複貼上

vba excel

Jamie 2020-10-22 13:28:51 ‧ 10196 瀏覽

分享至

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 }} |

直播中

1 個回答

海綿寶寶

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

回應 1
分享
檢舉

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

登入發表回應