解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

ReceiveList.rar (20.37 KB)

樓主熱帖

lpk187

高中生 Rank: 3 Rank: 3

帖子: 552
主題: 3
精華: 0
積分: 578
點名: 0
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2015-2-8
最後登錄: 2024-7-9

2016猴年全勤獎章 2015羊年全勤獎章熱烈參與勳章

2^#

發表於 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

TOP

oliwa