Copy & paste is stalling my macro - excel

Question

I have a macro which takes data from one workbook, filters the fairly large page down to the data i require only, then copies values to a dummy sheet in my main workbook where non required rows are removed and columns are sorted into an order more suitable for my application.
my problem is it takes an age to complete and quite often crashes.
I am still new to VBA and have tried my best to slicken the code but am not getting anywhere. I have used F8 to define the areas which slow it up and they are the filtering, copy/paste and cut/insert. If anyone can help it would be greatly appreciated.
Thanks in advance
M
`Sub NEW_OPS_AWAY_REPORT()
MsgBox ("BOTTLENECKS AND OPS AWAY SPREADSHEET & GEARSHOP WORK TO LIST FROM REPORT CENTRE MUST BE OPEN FOR THIS REPORT TO FUNCTION CORRECTLY")
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Windows("DAILY BOTTLENECKS ANALYSIS & OPS AWAY.xlsm").Activate
Sheets("WIP by Op").Visible = True
Sheets("WIP by Op").Range("$A$1:$Q$47290").AutoFilter Field:=1, Criteria1:="TS1H124*", Operator:=xlFilterValues
Windows("PRESS QUENCH FIRST OFF DATABASE.xlsm").Activate
Sheets("REPORT DATA TRANSFER").Visible = True
Sheets("REPORT DATA TRANSFER").Select
Cells.Select
Selection.ClearContents
Windows("DAILY BOTTLENECKS ANALYSIS & OPS AWAY.xlsm").Activate
Sheets("WIP by Op").Select
Cells.Select
Selection.Copy
Windows("PRESS QUENCH FIRST OFF DATABASE.xlsm").Activate
ActiveSheet.Paste
Range("F:F,G:G,H:H,M:M,P:P,Q:Q").Select
Range("Q1").Activate
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("A:K").Select
Columns("A:K").EntireColumn.AutoFit
Columns("J:J").Select
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Columns("I:I").Select
Selection.Cut
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Columns("J:J").Select
Selection.Cut
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Columns("G:G").Select
Selection.Cut
Columns("D:D").Select
Selection.Insert Shift:=xlToRight
Columns("H:H").Select
Selection.Cut
Columns("E:E").Select
Selection.Insert Shift:=xlToRight
Columns("H:H").Select
Selection.Cut
Columns("F:F").Select
Selection.Insert Shift:=xlToRight
Columns("J:J").Select
Selection.Cut
Columns("I:I").Select
Selection.Insert Shift:=xlToRight
Application.Calculation = xlCalculationAutomatic
Range("A1:K1").Select
Selection.AutoFilter
ActiveWorkbook.Worksheets("REPORT DATA TRANSFER").AutoFilter.Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("REPORT DATA TRANSFER").AutoFilter.Sort.SortFields. _
Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("REPORT DATA TRANSFER").AutoFilter.Sort
.header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("Ops Away Report").Select
Columns("A:K").Select
Selection.ClearContents
Sheets("REPORT DATA TRANSFER").Select
Columns("A:K").Select
Selection.Copy
Sheets("Ops Away Report").Select
Range("A1").Select
ActiveSheet.Paste
Range("A:A,E:E,F:F,I:I,J:J").Select
Range("J1").Activate
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A1:L1").Select
Selection.AutoFilter
Columns("B:B").Select
Sheets("REPORT DATA TRANSFER").Visible = False
Dim lastRow As Long
lastRow = Range("A2").End(xlDown).Row
For Each Cell In Range("A2:Q" & lastRow) ''change range accordingly
If Cell.Row Mod 2 = 1 Then ''highlights row 2,4,6 etc|= 0 highlights 1,3,5
Cell.Interior.ColorIndex = 34 ''color to preference
Else
Cell.Interior.ColorIndex = xlNone ''color to preference or remove
End If
Next Cell
Columns("D:D").EntireColumn.AutoFit
Columns("H:H").ColumnWidth = 7.43
Range("A1:O1").AutoFilter
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
End Sub`

Answer 1

Looking through your code there's a lot of extra code in there.
For instance, adding a border around each cell can be done with Selection.Borders.LineStyle = xlContinuous
This code starts with the two workbooks closed. Update the Const variables with the correct file paths.
You'll probably need to disable events still, depending on what code's in the other workbooks.
Public Sub New_Ops_Away_Report()
Const BottleNecks_Path As String = "C:\Somefolder\DAILY BOTTLENECKS ANALYSIS & OPS AWAY.xlsm"
Const OpsAway_Path As String = "C:\Somefolder\PRESS QUENCH FIRST OFF DATABASE.xlsm"
Dim wrkBk_BottleNeck As Workbook
Dim wrkbk_OpsAway As Workbook
Dim rWIP_LastCell As Range
Dim rReport_LastCell As Range
Set wrkBk_BottleNeck = Workbooks.Open(Filename:=BottleNecks_Path)
Set wrkbk_OpsAway = Workbooks.Open(Filename:=OpsAway_Path)
'Clear the contents of the named sheet.
wrkbk_OpsAway.Worksheets("REPORT DATA TRANSFER").Cells.ClearContents
With wrkBk_BottleNeck
'Find the last populated cell on the worksheet.
Set rWIP_LastCell = LastCell(.Worksheets("WIP by OP"))
With .Worksheets("WIP by OP")
With .Range(.Cells(1, 1), rWIP_LastCell)
'Add a filter from A1 to the last populated cell.
.AutoFilter Field:=1, Criteria1:="TS1H124*", Operator:=xlFilterValues
.Copy Destination:=wrkbk_OpsAway.Worksheets("REPORT DATA TRANSFER").Range("A1")
End With
End With
End With
With wrkbk_OpsAway.Worksheets("REPORT DATA TRANSFER")
''''''''''''''''''''''''
'This bit is confusing in your code.
'I think it's trying to do as below, but I've commented out the last line
'as it appears to clear the data you just copied over.
.Range("F:F,G:G,H:H,M:M,P:P,Q:Q").Delete Shift:=xlToLeft
.Columns("A:K").EntireColumn.AutoFit
'.Columns("A:J").EntireColumn.ClearContents
''''''''''''''''''''''''
'Find last populated cell on the worksheet.
Set rReport_LastCell = LastCell(wrkbk_OpsAway.Worksheets("REPORT DATA TRANSFER"))
With .Sort
.SortFields.Clear
.SortFields.Add Key:=Range("A1").Resize(rReport_LastCell.Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange wrkbk_OpsAway.Worksheets("REPORT DATA TRANSFER").Range("A1").Resize(rReport_LastCell.Row, rReport_LastCell.Column)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
.Range("A1").Resize(rReport_LastCell.Row, rReport_LastCell.Column).Borders.LineStyle = xlContinuous
End With
End Sub
Public Function LastCell(wrkSht As Worksheet, Optional Col As Long = 0) As Range
Dim lLastCol As Long, lLastRow As Long
On Error Resume Next
With wrkSht
lLastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
lLastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
If lLastCol = 0 Then lLastCol = 1
If lLastRow = 0 Then lLastRow = 1
Set LastCell = wrkSht.Cells(lLastRow, lLastCol)
End With
On Error GoTo 0
End Function