- 帖子
- 1018
- 主題
- 15
- 精華
- 0
- 積分
- 1058
- 點名
- 0
- 作業系統
- win7 32bit
- 軟體版本
- Office 2016 64-bit
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 桃園
- 註冊時間
- 2012-5-9
- 最後登錄
- 2022-9-28
|
2#
發表於 2013-4-26 13:08
| 只看該作者
回復 1# 3171jj
Sub example2()
Dim f, ar, r, fname
f = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls),*.xls", Title:="選擇多個檔案", MultiSelect:=True)
If Not IsArray(f) Then Exit Sub
Application.ScreenUpdating = False
'需要先建一個叫"彙整"的工作表
r = 1
For Each fname In f
With Workbooks.Open(fname)
.Sheets(1).Range("3:3,5:5,10:10,11:11").Copy ThisWorkbook.Sheets("彙整").Cells(r, "A")
r = r + 4 '每次新增4列
.Close False
End With
Next
Application.ScreenUpdating = True
End Sub |
|