Board logo

標題: [發問] 複製貼上問題 [打印本頁]
作者: cyfchuang    時間: 2024-10-15 15:39     標題: 複製貼上問題

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

我放在 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
複製代碼
[attach]37926[/attach]
作者: cyfchuang    時間: 2024-10-16 08:21

本帖最後由 cyfchuang 於 2024-10-16 08:25 編輯

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



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)