[Tasos]

Καλησπέρα Θανάση!

Δεν σε αντιληφθήκαμε και σε προσπεράσαμε

Είδα τον κώδικα σου και έχω να κάνω τις εξής παρατηρήσεις.

Χρησιμοποιείς συνεχώς Activate και Select. Δεν υπάρχει λόγος.
Δε χρειάζεται να κάνεις αναπαράσταση των κινήσεων που θα έκανες χειροκίνητα μέσα από τη VBA.
Σε πολλές περιπτώσεις δεν χρειάζεται καν να κάνεις Copy Paste προγραμματιστικά.

Για παράδειγμα: η γραμμή Range("A1:A100").Value = Range("B1:B100").Value αντιγράφει τις τιμές
από την περιοχή "B1:B100" στην περιοχή "Α1:Α100" χωρίς να χρειαστούν Select , Activate , Copy και Paste.

Δεν διαπίστωσα κάποια συντακτικά λάθη.
Η μόνη μου υποψία σε σχέση με το πρόβλημα βρίσκεται στη γραμμή Application.Run "PERSONAL.XLSB!Bold_Italic_Keywords.Bold_Italic_Ke ywords"

Ωστόσο αφού μελέτησα τη ροή του κώδικα σου σου προτείνω να μελετήσεις τις τεχνικές που εφαρμόζονται στον παρακάτω (ενδεικτικό) κώδικα:

Option Explicit

Sub ImportDataSpore()
    Dim rngTarget As Range, wbDelivery As Workbook, wbInvoice As Workbook, wb As Workbook
    Dim wbDeliveryPath As String, aLinks As Variant, i As Integer

    Set wbDelivery = Workbooks("Delivery.xlsx")
    wbDeliveryPath = wbDelivery.FullName
    Set wbInvoice = Workbooks("INVOICE Spore.xls")
    Set rngTarget = wbInvoice.Worksheets("PROVISIONS").Range("A10:E507")

    Application.ScreenUpdating = False

    rngTarget.Value = wbDelivery.Worksheets("ExcelDeliveryQry").Range("A3:E500").Value '***Import Data to Invoice

    wbDelivery.Close True '***Close Workbook 'Delivery.xlsx'

    On Error Resume Next
    Kill wbDeliveryPath '***Delete Workbook 'Delivery.xlsx'

    On Error GoTo 0
    Set rngTarget = rngTarget.Resize(rngTarget.Rows.Count + 1, rngTarget.Columns.Count)

    With rngTarget
        .Font.Name = "Calibri"
        .Font.Size = 11
        .VerticalAlignment = xlTop

        With .Columns(2)
            .ColumnWidth = 49.6 '***Autofit
            .HorizontalAlignment = xlLeft
            .WrapText = True
        End With

        With .Columns(7)
            .FormulaR1C1 = "=IF(RC[-2]<>"""",RC[-3]*RC[-2],"""")" '***Total (Qty * U/Price)
            .Value = .Columns(7).Value
        End With

        With .Parent.Range("G508")
            .Value = Application.Sum(.Columns(7))
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders.Weight = xlThin
            .Font.Bold = True
            .Font.Italic = True
        End With
        
        '***SGD Format
        .Parent.Range("E10:G508").NumberFormat = "_([$SGD] * #,##0.00_);_([$SGD] * (#,##0.00);_([$SGD] * ""-""??_);_(@_)"
        .Parent.Columns("E:G").EntireColumn.AutoFit

        With .Parent.Range("B508")
            .Value = "Total Net Amount"
            .Font.Bold = True
            .Font.Italic = True
        End With
    End With
    
    '***Remove Links (Not needed since all formulas are converted to values)
'    aLinks = wbInvoice.LinkSources(xlExcelLinks)
'    If Not IsEmpty(aLinks) Then
'        For i = 1 To UBound(aLinks)
'            wbInvoice.BreakLink aLinks(i), xlLinkTypeExcelLinks
'        Next
'    End If

    With wbInvoice.Worksheets("PROVISIONS")
        .Activate    ' Δεν ξέρω αν η επόμενη γραμμή προϋποθέτει την ενεργοποίηση του φύλλου
        '**** Bold Italic Keywords
        Application.Run "PERSONAL.XLSB!Bold_Italic_Keywords.Bold_Italic_Keywords"
        .Activate    ' Δεν ξέρω αν η προηγούμενη γραμμή απενεργοποιεί το φύλλο
        
        ' *****  Set Print Area
        .PageSetup.PrintArea = Range("A1:G" & Evaluate("=MAX((2:600<>"""")*ROW(2:600))")).Address
        .Copy
    End With
    
    ' ***** SaveAs...
    ActiveWorkbook.SaveAs Filename:="D:\Documents\AAA PDF Files" _
                                    & "\" & Range("B9").Value & ".xlsx", FileFormat:=xlOpenXMLWorkbook
                                    
    ' ***** Quit Application
    For Each wb In Application.Workbooks
        wb.Saved = True
    Next
    Application.Quit
End Sub

Καλή συνέχεια!

Τάσος