- 帖子
- 1
- 主題
- 1
- 精華
- 0
- 積分
- 2
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- SP1
- 閱讀權限
- 10
- 註冊時間
- 2015-5-14
- 最後登錄
- 2015-10-9
|
目前巨集已可以將所要開的資料夾內檔案開啟選擇所需的range並貼上新增的分頁 ,但欲加上開啟的檔名要加到 框選的range 前面一欄. 怎麼測試都用不出來....
請教各位先賢, 如何利用迴圈或者那一種寫法可以達到此目的. 煩請指教.謝謝
Workbooks("Get_report.xlsm").Activate '確認巨集檔案是正在執行中
Sheets("Address").Select
For i = 2 To 65536
Sheets("Address").Select
Sheets("Address").Activate
If Cells(i, 1).Value = "" Then Exit For
ToolID = Cells(i, 1).Value
'確認檔案是否存在
sPath$ = "D:\temp\Lot_Report\" & ToolID
sDir$ = Dir(sPath, vbDirectory)
If sDir = "" Then MsgBox " Path " & sDir & " Not Found"
sDir$ = Dir(sPath & "\*.*")
'新增機台頁次
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = ToolID
Do Until sDir = ""
'開檔路徑
Workbooks.OpenText fileName:="D:\temp\Lot_Report\" & ToolID & "\" & sDir, Origin:=xlWindows _
, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="|", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
'搜尋關鍵字
Cells.Find(What:="DYNAMIC ", After:=ActiveCell, LookIn:=xlFormulas, lookat:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, MatchByte:=False, SearchFormat:=False).Activate
'選擇需要的資料並複製到機台頁面
ActiveCell.Range("A1:J29").Select
Selection.Copy
Workbooks("Get_report.xlsm").Activate
Sheets(ToolID).Select
Sheets(ToolID).Activate
EndRow = ActiveSheet.UsedRange.Rows.Count + 1 '所有使用中的列數+1
Rows(EndRow).PasteSpecial Paste:=xlPasteValues '目前使用中的分頁,的最下方空白列貼上值
Application.DisplayAlerts = False
Workbooks(sDir).Close '關閉另存新檔的檔案
sDir = Dir() '讀取下一個檔案
Loop
Sheets(ToolID).Select
Sheets(ToolID).Activate
Range("A1").Select
Next |
|
發表於 2015-5-14 16:54
| 
