- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 1# character
試試看- Option Explicit
- Dim Show_File As Object
- Sub 加入檔案()
- Dim I As Integer
- Set Show_File = Application.FileDialog(msoFileDialogOpen)
- With Show_File
- .InitialFileName = "D:\*.xls" '指定 xls檔
- .AllowMultiSelect = True
- .Show
- If .SelectedItems.Count > 0 Then
- For I = 1 To .SelectedItems.Count
- Cells(I, 2) = .SelectedItems(I)
- Next
- End If
- End With
- End Sub
- Sub 執行()
- Dim I As Integer, Sh As Worksheet, Rng As Range
- Set Sh = Workbooks("貼上.xlsm").Sheets(1)
- With Show_File
- If .SelectedItems.Count > 0 Then
- For I = 1 To .SelectedItems.Count
- Set Rng = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Offset(1) 'A欄最後有資料列的下一列
- With Workbooks.Open(.SelectedItems(I))
- .Sheets(1).Range("A1:C6").Copy Rng
- .Close 0
- End With
- Next
- End If
- End With
- Sh.Parent.Save ' 貼上.xlsm 存檔
- End Sub
複製代碼 |
|