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

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

Sub DATA_INPUT()
Sheets("工作表1").Activate '''''''''為我把巨集指令放在"工作表1"
fds = Application.GetOpenFilename("Excel Files (*.xlsm;*.xlsx), *.xlsm;*.xlsx", , , , True)
If IsArray(fds) Then
For i = 1 To UBound(fds)
[A2].Offset(i - 1) = fds(i)
Next
End If
Sheets("工作表1").Activate
For Each a In Range([A2], Cells(Rows.Count, 1).End(xlUp))
[color=Yellow]With Workbooks.Open(a)[/color]..........................................................error 來源
.Sheets.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
.Close 0
End With
Next
Sheets("工作表1").Activate
End Sub

複製代碼

麻煩版上的大神
tks

樓主熱帖

Ian

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2833
主題: 10
精華: 0
積分: 2889
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-17

2^#

發表於 2020-1-31 10:53 | 只看該作者

程式碼看來沒問題,
也可正確執行~~

TOP

iverson105

小學生 Rank: 1

帖子: 27
主題: 11
精華: 0
積分: 38
點名: 0
作業系統: window
軟體版本: window7
閱讀權限: 10
性別: 男
註冊時間: 2019-12-12
最後登錄: 2021-4-21

3^#

發表於 2020-1-31 17:36 | 只看該作者

回復 2# 准提部林

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

Ian

TOP

jackyq

中學生 Rank: 2

帖子: 319
主題: 6
精華: 0
積分: 309
點名: 0
作業系統: xp
軟體版本: 2k
閱讀權限: 20
性別: 男
註冊時間: 2015-6-24
最後登錄: 2024-4-27

4^#

發表於 2020-1-31 20:21 | 只看該作者

本帖最後由 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

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2833
主題: 10
精華: 0
積分: 2889
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-17

5^#

發表於 2020-2-1 10:31 | 只看該作者

回復 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

========================

TOP

iverson105