- 帖子
- 39
- 主題
- 8
- 精華
- 0
- 積分
- 53
- 點名
- 0
- 作業系統
- WIN7
- 軟體版本
- 2003
- 閱讀權限
- 20
- 註冊時間
- 2013-11-16
- 最後登錄
- 2016-1-30
|
2#
發表於 2014-3-4 09:34
| 只看該作者
回復 1# a31075ha
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
類似像這一段這樣 只是貼上的方是希望跟導入產品規格的方式一樣 只有框選範圍內的指定欄位貼上 |
|
