麻辣家族討論版版 » Excel程式區 » 複製貼上問題

返回列表下一主題上一主題發帖

[發問] 複製貼上問題

中學生 Rank: 2

帖子: 3
主題: 1
精華: 0
積分: 54
點名: 2
作業系統: WIN7
軟體版本: OFFICE2010
閱讀權限: 20
性別: 男
註冊時間: 2016-12-8
最後登錄: 2024-11-25

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2024-10-15 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

T5.PNG (7.72 KB)

T5

T6.PNG (7.76 KB)

T6

T24.PNG (7.44 KB)

T24

1015.zip (8.22 KB)

1015

收藏

中學生 Rank: 2

帖子: 3
主題: 1
精華: 0
積分: 54
點名: 2
作業系統: WIN7
軟體版本: OFFICE2010
閱讀權限: 20
性別: 男
註冊時間: 2016-12-8
最後登錄: 2024-11-25

3^#

發表於 2024-10-16 08:21 | 只看該作者

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

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

高中生 Rank: 3 Rank: 3

帖子: 835
主題: 6
精華: 0
積分: 915
點名: 16
作業系統: Win 10,7
軟體版本: 2019,2013,2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-3
最後登錄: 2024-11-14

2^#

發表於 2024-10-16 02:49 | 只看該作者

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

Dim lRow&, lRows&
Dim sStr$
Dim dTar
Dim wsTar As Worksheet
Set dTar = CreateObject("Scripting.Dictionary") ' 搜尋關鍵字
For Each wsTar In Worksheets ' 遍歷所有工作表
sStr = wsTar.Name ' 工作表名稱
If Left(sStr, 1) = "T" Then
Worksheets(sStr).Cells.ClearContents ' 清除 "T" 開頭的工作表內容
dTar(sStr) = sStr ' 紀錄 "T" 開頭的工作表名稱,避免發生找不到工作表的錯誤
End If
Next
With Worksheets("AA")
lRows = .Cells(Rows.Count, 1).End(xlUp).Row ' 找最末列
lRow = 1
Do While lRow <= lRows
sStr = "T" & .Cells(lRow, 1) ' 工作表名稱
If dTar(sStr) <> "" Then ' 找到對應工作表
.Cells(lRow, 1).CurrentRegion.Copy ' 區塊複製
Worksheets(sStr).[A2].PasteSpecial Paste:=xlPasteValues ' 在對應工作表的 A2 貼上值
lRow = lRow + .Cells(lRow, 1).CurrentRegion.Rows.Count - 1 ' 跳過已處理的區塊
End If
lRow = lRow + 1
Loop
End With

複製代碼

1015_ans.zip (22 Bytes)

靜思自在 : 有時當思無時苦，好天要積雨來糧。

返回列表下一主題上一主題