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