[VBA] Application-defined or object-defined error

[devcon]

Καλησπέρα,

Χρησιμοποιώ την ακόλουθη συνάρτηση και όλα πηγαίνουν άριστα μέχρι την στιγμή που ζητώ στο Excel να κλείσει ως εφαρμογή.
Το μήνυμα λάθους που μου δείχνει είναι “Application-defined or object-defined error”.

Που είναι το λάθος;

Ευχαριστώ εκ των προτέρων για την βοήθεια σας.

Sub ImportDataSpore()
            
' **** Spore Invoice *****
           
'***Import data from other spreadsheet

        Application.ScreenUpdating = False

'***Import Data to Invoice
        Workbooks("Delivery.xlsx").Activate
        Worksheets("ExcelDeliveryQry").Range("A3", "E500").Select
        Selection.Copy
        Workbooks("INVOICE Spore.xls").Worksheets("PROVISIONS").Activate
        Range("A10").Select
        Workbooks("INVOICE Spore.xls").Worksheets("PROVISIONS").Paste
        Application.CutCopyMode = False
        Windows("INVOICE Spore.xls").Activate
        Range("B10").Select
        Workbooks("Delivery.xlsx").Close True
  
  
  Columns("B:B").ColumnWidth = 49.6
  
       
 '***Total (Qty * U/Price)
    
    Dim FirstRow As Long, FinalRow As Long, CalcRows As Long
    FirstRow = ActiveCell.Row
    FinalRow = Cells(Rows.Count, 2).End(xlUp).Row
    CalcRows = FinalRow - FirstRow + 1
    
  With Range("G10" & ":G" & FinalRow)
        .FormulaR1C1 = "=IF(RC[-2]<>"""",RC[-3]*RC[-2],"""")"
    End With

  
  '***Sum Net Amount
  
        Range("G10").Select
        LastRow = Cells(Rows.Count, "G").End(xlUp).Row
        Range("G" & LastRow + 1).Formula = "=sum(G10:G" & LastRow & ")"
    
     Range("G" & LastRow).Select
     With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    
   '***Bold Insert Net Amount
    
    Dim LR As Long
    
    LR = Cells(Rows.Count, "G").End(xlUp).Row
    
    Cells(LR, "B").Select
    ActiveCell.FormulaR1C1 = "Total Net Amount"
    Selection.Font.Bold = True
    Selection.Font.Italic = True
    Cells(LR, "G").Select
    Selection.Font.Bold = True
    Selection.Font.Italic = True
    
    
    '***Autofit
    Columns("E:G").Select
    Columns("E:G").EntireColumn.AutoFit
    
    '***Left Aligment
        Range("B9", Range("B9").End(xlDown)).Select
        With Selection
        .Font.Name = "Calibri"
        .Font.Size = 11
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlTop
        .WrapText = True
        End With
    
    Range("G10", Range("G10").End(xlDown)).Select
        With Selection
        .Font.Name = "Calibri"
        .Font.Size = 11
        .VerticalAlignment = xlTop
        End With
        
    '***SGD Format
        
        Range("E10", Range("G10").End(xlDown)).Select
        Selection.NumberFormat = _
        "_([$SGD] * #,##0.00_);_([$SGD] * (#,##0.00);_([$SGD] * ""-""??_);_(@_)"
   
       
    '***Remove Links
    
    ActiveWorkbook.BreakLink Name:= _
        "D:\Documents\AAA PDF Files\Delivery.xlsx", Type:=xlExcelLinks
    With Selection
        .VerticalAlignment = xlTop
        .Orientation = 0
        .ReadingOrder = xlContext
    End With
    
    
    ' *****  Set Print Area  *******

Dim lastCell As Range
Set lastCell = Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0)
Do Until Application.Count(lastCell.EntireRow) <> 0
Set lastCell = lastCell.Offset(-1, 0)
Loop
ActiveSheet.PageSetup.PrintArea = Range(Cells(1, 1), lastCell).Address

    
'**** Bold Italic Keywords
    Application.Run "PERSONAL.XLSB!Bold_Italic_Keywords.Bold_Italic_Keywords"
    
    ' ****** SaveAs
    Workbooks("Invoice Spore.xls").Activate
    Range("B9").Select
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:="D:\Documents\AAA PDF Files" _
    & "\" & ActiveCell.Value & ".xlsx", FileFormat:=51
    'FileFormat:=xlWorkbookNormal
      
    Application.ScreenUpdating = True
      
 ****** Close & Delete Delivery.xlsx
    On Error Resume Next
    Kill "D:\Documents\AAA PDF Files\Delivery.xlsx"
    ActiveWorkbook.Close SaveChanges:=False
    ActiveWorkbook.Close SaveChanges:=False
    On Error GoTo 0
    Application.Quit
    
End Sub