解Bug

oliwa

有上百個檔案 , 如附件中的"上華" , "光鈦"檔案 ,
擬以如下程式抄寫至"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

回復 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

感謝.......

oliwa

測試結果粉理想 , 感謝 lkp187 的協助 !!