[發問] 複製貼上問題

cyfchuang

VBA新手，請教大大們，下列複製資料，要怎麼使用VBA完成
AA 活頁中，要把 A 欄 5、6、24 區間的資料，分別複製到 T5、T6、T24 活頁的 A2 欄位純文字貼上
另外，當 AA 活頁中，A 欄只有 5、24 區間的資料，分別複製到 T5、T24 活頁的 A2 欄位純文字貼上，如何避免 error

luhpro

我放在 Open 裡, 你再自己改放到你要的 Sub 裡 :

1.   Dim lRow&, lRows&
   
2.   Dim sStr$
   
3.   Dim dTar
   
4.   Dim wsTar As Worksheet
   
5.    
   
6.   Set dTar = CreateObject("Scripting.Dictionary") ' 搜尋關鍵字
   
7.   
   
8.   For Each wsTar In Worksheets ' 遍歷所有工作表
   
9.     sStr = wsTar.Name ' 工作表名稱
   
10.     If Left(sStr, 1) = "T" Then
    
11.       Worksheets(sStr).Cells.ClearContents ' 清除 "T" 開頭的工作表內容
    
12.       dTar(sStr) = sStr ' 紀錄 "T" 開頭的工作表名稱,避免發生找不到工作表的錯誤
    
13.     End If
    
14.   Next
    
15.   
    
16.   With Worksheets("AA")
    
17.     lRows = .Cells(Rows.Count, 1).End(xlUp).Row ' 找最末列
    
18.     lRow = 1
    
19.    
    
20.     Do While lRow <= lRows
    
21.       sStr = "T" & .Cells(lRow, 1) ' 工作表名稱
    
22.       If dTar(sStr) <> "" Then ' 找到對應工作表
    
23.         .Cells(lRow, 1).CurrentRegion.Copy ' 區塊複製
    
24.         Worksheets(sStr).[A2].PasteSpecial Paste:=xlPasteValues ' 在對應工作表的 A2 貼上值
    
25.         lRow = lRow + .Cells(lRow, 1).CurrentRegion.Rows.Count - 1 ' 跳過已處理的區塊
    
26.       End If
    
27.       lRow = lRow + 1
    
28.     Loop
    
29.   End With

複製代碼

1015_ans.zip (22 Bytes)

下載次數: 4

2024-10-16 02:49

cyfchuang

可以使用，而且還有詳細的註解，適合新手學習，謝謝 @luhpro 大大的幫忙