標題: 既有VB，如何含註解複製過去? [打印本頁]

---

作者: dakiu    時間: 2018-11-29 11:42     標題: 既有VB，如何含註解複製過去?

本帖最後由 dakiu 於 2018-11-29 11:43 編輯

各位前輩好:
以下是1個sheet的內容分別依指定儲存格複製至很多依指定excel檔名的儲存格內，但現在需要含註解必需也能複製，但不知可否在程式碼內加入，目前註解無法複製中，懇請前輩指導，感謝!

Sub 回存一次二次資料()

''回存時須確認sheet指定位置是否正確

Dim A As Range, B As Range, N%
Dim X As New Application, FN$, xB As Workbook
For Each A In [$e$2:$bs$2] ''受評人數範圍-僅工號列
    N = N + 1
    FN = ThisWorkbook.Path & "\" & "5--自評完成資料" & "\" & A.Value & ".xlsm" ''本檔放在抓取檔案上一層
    If Dir(FN) = "" Then GoTo 101
    Set xB = X.Workbooks.Open(FN)
For Each B In [$e$4:$e$55] ''選擇回存的儲存格位置
    On Error Resume Next
    If Range(B.Value) Is Nothing Then GoTo 102
    On Error GoTo 0
    xB.Sheets(2).Range(B).Value = B(1, N + 1)
102: Next
    xB.Close 1
101: Next

End Sub

---

作者: 准提部林    時間: 2018-12-1 11:54

本帖最後由 准提部林 於 2018-12-1 11:57 編輯

還是用直接開啟檔案吧!!!  

Sub 回存一次二次資料()
Dim A As Range, B As Range, N%
Dim FN$, xB As Workbook
For Each A In [$e$2:$bs$2] ''受評人數範圍-僅工號列
    N = N + 1
    FN = ThisWorkbook.Path & "\" & "5--自評完成資料" & "\" & A.Value & ".xlsm" ''本檔放在抓取檔案上一層
    If Dir(FN) = "" Then GoTo 101
    Application.ScreenUpdating = False
    Set xB = Workbooks.Open(FN)
    ThisWorkbook.Activate
    For Each B In [$e$4:$e$55] ''選擇回存的儲存格位置
        On Error Resume Next
        If Range(B.Value) Is Nothing Then GoTo 102
        On Error GoTo 0
        B(1, N + 1)copy xB.Sheets(2).Range(B)
    102: Next
    xB.Close 1
101: Next
End Sub

---

作者: dakiu    時間: 2018-12-3 09:51

謝謝版大:
努力消化吸收中!

---

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