Tinh giảm luọng code để chạy tốt hơn

[chuotchuix]

mình có đoạn code hơi dài dòng nen code chạy rất chậm các bác xem giúp có thể điều chỉnh chỗ nào để cải thiện đoạn code với

Sub RUN()
Dim ws As Worksheet, Arrsh As String
Sheet1.[D6].AutoFilter
'Sheet1.[a600:ag1048576].Delete
Sheet1.[A8:Ag600].ClearContents
Sheet1.Columns("M").NumberFormat = "@"
Application.ScreenUpdating = False
' On Error Resume Next
Arrsh = "?QCCHO?ORDER?ONLINE?PLAN?plan-IN?"
For Each ws In Worksheets
If InStr(1, Arrsh, "?" & ws.Name & "?", vbTextCompare) = 0 Then
'MsgBox ws.Name
abc ws
End If
Next
Sheet1.[C8].Resize(60000, 11).RemoveDuplicates Columns:=Array(1, 3, 5, 6, 7, 8, 11), Header:=xlNo
Sheet1.[c7] = "MAY"
Sheet1.[C8].Resize(60000, 11).Sort ActiveSheet.Range("c7"), 1
' to mau vang
Sheet1.[C8].Copy
Sheet1.[C8:J600].PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Call cgthu
'an dong trong
Sheet1.[D6].AutoFilter
Sheet1.[A$6:$AG$600].AutoFilter Field:=4, Criteria1:="<>"
'ke khung
Sheet1.[A8:Ag600].Select
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
Sheet1.[I4].Select
'dinh dang
Sheet1.[Q8:Q600].NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
Sheet1.[A8:Ag600].Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = True
.ReadingOrder = xlContext
.MergeCells = False
End With
'Sheet1.[AB29945].Select
Application.ScreenUpdating = 1
End Sub