- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 17# brabus
試試看- Option Explicit
- Sub Ex()
- Dim xPath As String, xFile As String, AR(), i As Integer
- With Application.FileDialog(msoFileDialogFolderPicker)
- '.InitialFileName = "D:\TEST\" '可預定資料夾
- If .Show = True Then xPath = .SelectedItems(1)
- '.Show = True :檔案對話方塊中按下確定->選定資料夾
- End With
- If xPath = "" Then MsgBox "沒有選擇資料夾 !!", vbQuestion : Exit Sub
- AR = Workbooks("我是主要資料.xls").Sheets("資料確認").UsedRange.Value
- xFile = Dir(xPath & "\*xls", vbDirectory) '選定資料夾中搜尋指定類型的檔案
- Application.ScreenUpdating = False
- Do While xFile <> "" '有找到指定類型的檔案
- With Workbooks.Open(xPath & "\" & xFile)
- .Sheets("資料確認").[a1].Resize(UBound(AR), UBound(AR, 2)) = AR
- .Close True '關閉存檔
- End With
- xFile = Dir '依序 下一個指定類型的檔案
- Loop
- Application.ScreenUpdating = True
- End Sub
複製代碼 |
|