標題:
解Bug
[打印本頁]
作者:
oliwa
時間:
2016-9-25 20:12
標題:
解Bug
有上百個檔案 , 如附件中的"上華" , "光鈦"檔案 ,
擬以如下程式抄寫至"ReceiveList"檔案 ,
目前測試時 Msgbox file 正確 , 但 MsgBox LastRow 卻顯示 1048576 , 且程式中斷 ,
請問那裏有問題呀 ? TKS .
Sub M1()
Dim path$, file$, first$
path = "C:\Users\oliwa\Desktop\5-成本分析資料\10501進貨\"
file = Dir(path & "*.xls")
If file = "" Then Exit Sub
first = file
Do
MsgBox file
Workbooks.Open (path & file)
StartRow = Range("A1:A10").Find("發票號碼").Row + 1
CopyRow = Cells(1, "A").End(xlDown).Row
Range("A" & StartRow & ":K" & CopyRow).Select
Selection.Copy
Windows("ReceiveList.xlsm").Activate
LastRow = Cells(1, "A").End(xlDown).Row
MsgBox LastRow
Range("A" & LastRow + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(path & file).Activate
ActiveWindow.Close
file = Dir
Loop While file <> "" And first <> file
ActiveWorkbook.Save
End Sub
作者:
lpk187
時間:
2016-9-26 01:28
回復
1#
oliwa
Do
MsgBox file
Workbooks.Open (path & file)
StartRow = Range("A1:A10").Find("發票號碼").Row + 1
CopyRow = Cells(65535, "A").End(xlUp).Row '不要從第一列往下找，當第一列是空白，或第一列有值，而第二列空白是找到的row 都會是最後一列，找到的幾乎是1048576 或 65535
MsgBox SatrRow & "+" & CopyRowy
Range("A" & StartRow & ":K" & CopyRow).Select
Selection.Copy
Windows("ReceiveList.xlsm").Activate
'Sheets("工作表1").Select
LastRow = Cells(65535, "A").End(xlUp).Row '同上解釋
MsgBox LastRow
Range("A" & LastRow + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(file).Close '這是不是關閉 Wihdows ，而是要關閉活頁簿
file = Dir
Loop While file <> "" And first <> file
作者:
oliwa
時間:
2016-9-30 16:48
感謝.......
作者:
oliwa
時間:
2016-10-1 14:02
測試結果粉理想 , 感謝 lkp187 的協助 !!
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)
