返回列表 上一主題 發帖

[發問] 複製貼上問題

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
1  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2025-7-5 
1# 跳轉到 »
發表於 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
複製代碼
1015_ans.zip (22 Bytes)

TOP

        靜思自在 : 【時間無法遮擋】怕時間消逝，花了許多心血，想盡各式方法要遮擋時間，結果是：浪費了更多時間，且一無所成！
返回列表 上一主題