返回列表 上一主題 發帖

[發問] 複製貼上問題

cyfchuang

帖子
2 
主題
1 
精華
0 
積分
53 
點名
2  
作業系統
WIN7 
軟體版本
OFFICE2010 
閱讀權限
20 
性別
男 
註冊時間
2016-12-8 
最後登錄
2024-10-16 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 昨天 15:39 | 只看該作者

[發問] 複製貼上問題

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

AA.PNG (13.99 KB)

AA

AA.PNG

T5.PNG (7.72 KB)

T5

T5.PNG

T6.PNG (7.76 KB)

T6

T6.PNG

T24.PNG (7.44 KB)

T24

T24.PNG

1015.zip (8.22 KB)

1015

收藏 分享

luhpro

帖子
834 
主題
6 
精華
0 
積分
914 
點名
11  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-10-16 
2#
發表於 5 小時前 | 只看該作者
我放在 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)

TOP

        靜思自在 : 【做人的開始】每一天都是故人的開始，每一個時刻都是自己的警惕。
返回列表 上一主題