Want to reduce Macro running time

I have macro script, which is working well be said file taken much time to execute,

please help me to reduce time of execution.

Ravi
===

Sub Contractor_TEUs()
Dim fPATH As String, fNAME As String
Dim PA As String
Dim R, D, M, N, C As Integer
Dim LR As Long, NR As Long
Dim Z As Range
Dim EXWKBK, NWWKBK, wbGRP As Workbook, wsDEST As Worksheet

Windows("Consolidate data from folder with VlookUp.xls").Activate
Range("G11").Select
If Range("G11").Value = Empty Then
    MsgBox "Please Enter Proper Folder Path", vbCritical + vbOKOnly
Else
    PA = ActiveCell.Value
    Workbooks.Add
    Set EXWKBK = ActiveWorkbook
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "contractorcode"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "EQ_NBR"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "TSERV_ID"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "FROM_CHE_ID"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "TO_CHE_ID"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "POW_ID"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "EQSZ_ID"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Date"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "Day"        ' considering shift from 8 to 8
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "TEUs"       ' calculated basis size
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "Lot"        ' vloook through assigned TT & lot
    
    fPATH = PA & "\"       'remember the final \ in this string
    
    fNAME = Dir(fPATH & "*.xls")        'get the first filename in fpath
    Application.DisplayAlerts = False
    Do While Len(fNAME) > 0
        Set wbGRP = Workbooks.Open(fPATH & fNAME) 'open the file
        wbGRP.Activate
        Range("D9").Select
    '    Selection.End(xlDown).Select
        Set Z = Cells.Find(What:="contractorcode", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        True, SearchFormat:=False)
        Z.Select
        N = ActiveCell.Row
        Selection.End(xlDown).Select
        LR = ActiveCell.Row
        If LR > 1 Then
            Range("A" & N + 1 & ":H" & LR).Select
            Selection.Copy
            EXWKBK.Activate
            If Range("A2").Value = Empty Then
                Range("A2").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Else
                Range("A1").Select
                Selection.End(xlDown).Select
                ActiveCell.Offset(1, 0).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            End If
            'wsDEST.Range ("A" & NR) ' = Replace(Range("A1"), "Group ", "")
        End If
        wbGRP.Close False   'close data workbook
        fNAME = Dir         'get the next filename
    Loop
    EXWKBK.Activate
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "=IF(HOUR(RC[-1])<8,DATE(YEAR(RC[-1]),MONTH(RC[-1]),DAY(RC[-1]))-1,DATE(YEAR(RC[-1]),MONTH(RC[-1]),DAY(RC[-1])))"
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-3]=""20"",1,2)"
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC5,'[Consolidate data from folder with VlookUp.xls]Sheet1'!C1:C2,2,0)"     'considering column 2 & 3 and target value is in column 3'
    Range("H2").Select
    Selection.End(xlDown).Select
    D = ActiveCell.Row
    Range("I2:K" & D).Select
    Selection.FillDown
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Columns("I:I").Select
    Selection.NumberFormat = "[$-409]d-mmm-yy;@"
    Columns("H:H").Select
    Selection.NumberFormat = "[$-409]dd-mmm-yy h:mm AM/PM;@"
    Range("A1").Select
    Selection.CurrentRegion.Select
     With Selection.Font
        .Name = "Verdana"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select
    Selection.CurrentRegion.Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
        Range("A1").Select
    End With
    'Range("I2:I" & D).Select
    'Selection.Copy
    'Range("M2").Select
    'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    ':=False, Transpose:=False
    'Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
    ':=False, Transpose:=False
    'Application.CutCopyMode = False
    'ActiveSheet.Range("M2:M" & D).RemoveDuplicates Columns:=1, Header:=xlNo
    'Range("M2").Select
    'If Range("M3").Value = Empty Then
    'M = ActiveCell.Row
    'Else
    'Selection.End(xlDown).Select
    'M = ActiveCell.Row
    'End If
    'Range("M2:M" & M).Select
    'Selection.Copy
    'Range("O3").Select
    'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    ':=False, Transpose:=False
    'Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
    ':=False, Transpose:=False
    'EXWKBK.Activate
    'Range("K2:K" & D).Select
    'Selection.Copy
    'Range("M2").Select
    'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    'Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
    ':=False, Transpose:=False
    'Application.CutCopyMode = False
    'ActiveSheet.Range("M2:M" & D).RemoveDuplicates Columns:=1, Header:=xlNo
    'Range("M2").Select
    'If Range("M3").Value = Empty Then
    'M = ActiveCell.Row
    'Else
    'Selection.End(xlDown).Select
    'M = ActiveCell.Row
    'End If
    'Range("M2:M" & M).Select
    'Selection.Copy
    'Range("P2").Select
    'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    ':=False, Transpose:=True
    'Range("P3").Select
    'ActiveCell.FormulaR1C1 = "=SUMIFS(C10,C9,RC15,C11,R2C)"
    'If Range("Q2").Value = Empty Then
    'Else
    'Range("P3").Select
    'Selection.Copy
    'Range("Q2").Select
    'Selection.End(xlToRight).Select
    'C = ActiveCell.Column
    'ActiveCell.Offset(1, 0).Select
    'Range(Selection, Selection.End(xlToLeft)).Select
    'Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
    ':=False, Transpose:=False
    'End If
    'If Range("O4").Value = Empty Then
    'Else
    'Range("P3").Select
    'Selection.End(xlToRight).Select
    'Range("P3:AP3000").Select
    'Selection.FillDown
    'Range("O3").Select
    'Selection.End(xlDown).Select
    'ActiveCell.Offset(1, 1).Select
    'Range(Selection, Selection.End(xlToRight)).Select
    'Range(Selection, Selection.End(xlDown)).Select
    'Selection.ClearContents
    'Range("P2").Select
    'Selection.End(xlToRight).Select
    'ActiveCell.Offset(1, 1).Select
    'Selection.End(xlToRight).Select
    'Range(Selection, Selection.End(xlDown)).Select
    'Selection.ClearContents
    'End If
    'Range("P3").Select
    'Selection.CurrentRegion.Select
    'Selection.Copy
    'Workbooks.Add
    'Set NWWKBK = ActiveWorkbook
    'NWWKBK.Activate
    'Range("A2").Select
    'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    ':=False, Transpose:=False
    'Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
    ':=False, Transpose:=False
    'Range("A2").Select
    'ActiveCell.FormulaR1C1 = "Date"
    'Range("A:A").Select
    'Selection.NumberFormat = "mm/dd/yyyy"
    'Range("A2").Select
    'EXWKBK.Activate
    'ActiveWindow.Close
    Windows("Consolidate data from folder with VlookUp.xls").Activate
    ActiveWindow.Close
    NWWKBK.Activate
    Application.DisplayAlerts = True
End If
End Sub

====