返回列表 上一主題 發帖

開啟多個檔案 複製貼上(進階執行問題).....急

開啟多個檔案 複製貼上(進階執行問題).....急

大家好,爬了很多 文   看到超級版主Hsieh 的程式分享來用,卻還是不知該怎麼完成我想要的功能
我想做的事是:
打開 "開檔貼上.xlsm"
1. 按"加入檔案"的按鈕,選擇多個檔案
2. 將選擇的檔案路逕+檔案名稱 填寫到 A欄位
3. 將 A欄位的資料打開,並自動貼在自動新增的Sheet上   ..............一直bug
目前已爬文到程式碼如下
  1. Sub DATA_INPUT()
  2. Sheets("工作表1").Activate     '''''''''為我把巨集指令放在"工作表1"

  3. fds = Application.GetOpenFilename("Excel Files (*.xlsm;*.xlsx), *.xlsm;*.xlsx", , , , True)
  4. If IsArray(fds) Then
  5. For i = 1 To UBound(fds)
  6.    [A2].Offset(i - 1) = fds(i)
  7. Next
  8. End If

  9. Sheets("工作表1").Activate

  10. For Each a In Range([A2], Cells(Rows.Count, 1).End(xlUp))
  11.     [color=Yellow]With Workbooks.Open(a)[/color]..........................................................error 來源
  12.     .Sheets.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  13.     .Close 0
  14.   End With
  15.   Next
  16. Sheets("工作表1").Activate
  17. End Sub
複製代碼
麻煩版上的大神
tks
Ian

程式碼看來沒問題,
也可正確執行~~
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

回復 2# 准提部林


    Hello 版主
請教????
  我發現原來在A column要完全空白;只要有任何文字error就會產生
  求解???

ISSUE1.png
2020-1-31 17:35
Ian

TOP

本帖最後由 jackyq 於 2020-1-31 20:23 編輯

on error resume next  ' 把錯誤跳過去就好了

For Each a In Range([A2], Cells(Rows.Count, 1).End(xlUp))
    With Workbooks.Open(a)
    .Sheets.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    .Close 0
   End With
  Next
Sheets("工作表1").Activate

on error goto 0

TOP

回復 3# iverson105

載入檔案清單前, 應將A欄清空
Sub DATA_INPUT()
Sheets("工作表1").Activate
Range([A2], Cells(Rows.Count, 1).End(xlUp)(2)).ClearContents
續~原程式碼~~
End Sub

=========================
開啟檔案前, 先用DIR檢查是否存在~~
If Dir(A) <> "" Then   
    With Workbooks.Open(A)
         .Sheets.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
         .Close 0
    End With
End If  


========================
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

回復 4# jackyq

ok..搞定了,謝謝指教
感謝
Ian

TOP

回復 5# 准提部林

oK,搞定了
感謝版主幫忙
Ian

TOP

        靜思自在 : 站在半路,比走到目標更辛苦。
返回列表 上一主題