Copy and paste is very slow to do work

hi,
this is working ok but very slow to do work, need help to improve speed of this code

thank you

Sub COPY_DITTO_FINAL()
Application.ScreenUpdating = False
If ActiveSheet.Name = "OL BC" Then
Dim NextRow As Range
Set NextRow = Sheet5.Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1, 0)
Sheet5.Cells(Cells.Rows.Count, 1).End(xlUp).Offset(0, 0).EntireRow.Copy
NextRow.PasteSpecial ' (xlValues)
Sheet5.Cells(Cells.Rows.Count, 1).End(xlUp).Offset(0, 6).Value = 1
Range("H10").End(xlDown).Offset(0, 0).Select
Else: End If
Application.ScreenUpdating = True
End Sub

Hi HaroonSid

I suspect if you have formulas in the row then using Offset could be the culprit because it will cause the wsheet to recalculate. Also I find copying entire rows or columns can be very slow so try to limit the number of columns by finding the last real column used.
Try this:

Sub COPY_DITTO_FINAL()

    With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    
    If ActiveSheet.Name = "OL BC" Then
    
        Dim nLastRow As Long
        Dim nLastColumn As Long
    
        With Sheets(5)
        ' find last row and last column
            nLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            nLastColumn = .Cells.Find("*", .Cells(1), xlFormulas, xlPart, xlByColumns, xlPrevious).Column
            
            'copy paste to next row
            .Range(.Cells(nLastRow, "A"), .Cells(nLastRow, nLastColumn)).Copy .Cells(nLastRow + 1, "A") 
   
'NOTE:if you need to use PasteSpecial then delete the line above
'and use these next 2 lines
'.Range(.Cells(nLastRow, "A"), .Cells(nLastRow, nLastColumn)).Copy
'.Cells(nLastRow + 1, "A") .PasteSpecial xlPasteAll
            
            'insert value to "F" new last row
            .Cells(nLastRow + 1, "F") = 1
            
            Range("H10").End(xlDown).Select
            
        End With
        
    Else: End If

    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    End With
    
End Sub

hth