Option Explicit

Sub Driver_Analysis()
Dim i As Long, lrow As Long, j As Long, lastrow As Long

Application.ScreenUpdating = False

If Not Evaluate("ISREF(Driver_Analysis!A1)") Then
    Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Driver_Analysis"
Else
    Worksheets("Driver_Analysis").Delete
    Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Driver_Analysis"
End If

Worksheets("Driver_Analysis").Range("A4:K4") = Split("Date,Trucks,Weather Conditions,Driver,KM,Diesel Req No,Diesel Filled (Litres), Diesel Consumption, Trip Sheet, Weighbridge Ticket, Tons", ",")
Worksheets("Driver_Analysis").Rows(4).Font.Bold = True

For i = 1 To Worksheets.Count
    With Worksheets(i)
        If Len(.Name) <= 2 Then
            lrow = .Range("D" & .Rows.Count).End(xlUp).Row
            For j = 7 To lrow
                If .Range("A" & j).Value <> "" Then
                    lastrow = Worksheets("Driver_Analysis").Range("A" & Rows.Count).End(xlUp).Row
                    .Range("A" & j & ":C" & j).Copy
                    Worksheets("Driver_Analysis").Range("A" & lastrow + 1).PasteSpecial (xlPasteValuesAndNumberFormats)
                    .Range("E" & j).Copy
                    Worksheets("Driver_Analysis").Range("D" & lastrow + 1).PasteSpecial (xlPasteValuesAndNumberFormats)
                    .Range("H" & j & ":K" & j).Copy
                    Worksheets("Driver_Analysis").Range("E" & lastrow + 1).PasteSpecial (xlPasteValuesAndNumberFormats)
                    Worksheets("Driver_Analysis").Range("E" & lastrow + 1).PasteSpecial (xlPasteFormats)
                    Worksheets("Driver_Analysis").Range("E" & lastrow + 1).PasteSpecial (xlPasteComments)
                    .Range("M" & j & ":N" & j).Copy
                    Worksheets("Driver_Analysis").Range("I" & lastrow + 1).PasteSpecial (xlPasteValuesAndNumberFormats)
                    Worksheets("Driver_Analysis").Range("I" & lastrow + 1).PasteSpecial (xlPasteFormats)
                    Worksheets("Driver_Analysis").Range("I" & lastrow + 1).PasteSpecial (xlPasteComments)
                     .Range("Y" & j).Copy
                    Worksheets("Driver_Analysis").Range("K" & lastrow + 1).PasteSpecial (xlPasteValuesAndNumberFormats)
                End If
            Next j
        End If
    End With
Next i

With Worksheets("Driver_Analysis")
    lrow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Sort.SortFields.Add Key:=Range("D5:D" & lrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With .Sort
        .SetRange Range("A4:K" & lrow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    .Range("A4:K" & lrow).Subtotal GroupBy:=4, Function:=xlSum, TotalList:=Array(5, 7), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
        
    lrow = .Range("D" & .Rows.Count).End(xlUp).Row
    
    For i = 5 To lrow
        If .Range("D" & i).Value Like "*Total" And .Range("D" & i).Value <> "Grand Total" Then
            .Range("H" & i).Value = .Range("E" & i).Value / .Range("G" & i).Value
        ElseIf .Range("C" & i).Value = "Grand Total" Then
            .Rows(i).Font.Bold = True
            .Rows(i).Font.Color = -16776961
            .Range("H" & i).Value = .Range("E" & i).Value / .Range("G" & i).Value
        End If
    Next i
    
    .Cells.EntireColumn.AutoFit
        
    With .Range("A4:K" & lrow)
        .Font.Size = 8
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        With .Borders()
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
    End With
    
End With

Application.ScreenUpdating = True

End Sub
Option Explicit
Sub Truck_Analysis()
Dim i As Long, lrow As Long, j As Long, lastrow As Long
Dim mycmt As Variant

Application.ScreenUpdating = False

If Not Evaluate("ISREF(Truck_Analysis!A1)") Then
    Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Truck_Analysis"
Else
    Worksheets("Truck_Analysis").Delete
    Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Truck_Analysis"
End If

Worksheets("Truck_Analysis").Range("A1:K1") = Split("Date,Trucks,Weather Conditions,Driver,KM,Diesel Req No,Diesel Filled (l), Diesel Consumption, Trip Sheet, Weighbridge Ticket, Tons", ",")
Worksheets("Truck_Analysis").Rows(1).Font.Bold = True

For i = 1 To Worksheets.Count
    With Worksheets(i)
        If Len(.Name) <= 2 Then
            lrow = .Range("D" & .Rows.Count).End(xlUp).Row
            For j = 7 To lrow
                If .Range("A" & j).Value <> "" Then
                    lastrow = Worksheets("Truck_Analysis").Range("A" & Rows.Count).End(xlUp).Row
                    .Range("A" & j & ":C" & j).Copy
                    Worksheets("Truck_Analysis").Range("A" & lastrow + 1).PasteSpecial (xlPasteValuesAndNumberFormats)
                    Worksheets("Truck_Analysis").Range("A" & lastrow + 1).PasteSpecial (xlPasteFormats)
                    Worksheets("Truck_Analysis").Range("A" & lastrow + 1).PasteSpecial (xlPasteComments)
                    .Range("E" & j).Copy
                    Worksheets("Truck_Analysis").Range("D" & lastrow + 1).PasteSpecial (xlPasteValuesAndNumberFormats)
                    Worksheets("Truck_Analysis").Range("D" & lastrow + 1).PasteSpecial (xlPasteFormats)
                    Worksheets("Truck_Analysis").Range("D" & lastrow + 1).PasteSpecial (xlPasteComments)
                    .Range("H" & j & ":K" & j).Copy
                    Worksheets("Truck_Analysis").Range("E" & lastrow + 1).PasteSpecial (xlPasteValuesAndNumberFormats)
                    Worksheets("Truck_Analysis").Range("E" & lastrow + 1).PasteSpecial (xlPasteFormats)
                    Worksheets("Truck_Analysis").Range("E" & lastrow + 1).PasteSpecial (xlPasteComments)
                    .Range("M" & j & ":N" & j).Copy
                    Worksheets("Truck_Analysis").Range("I" & lastrow + 1).PasteSpecial (xlPasteValuesAndNumberFormats)
                    Worksheets("Truck_Analysis").Range("I" & lastrow + 1).PasteSpecial (xlPasteFormats)
                    Worksheets("Truck_Analysis").Range("I" & lastrow + 1).PasteSpecial (xlPasteComments)
                     .Range("Y" & j).Copy
                    Worksheets("Truck_Analysis").Range("K" & lastrow + 1).PasteSpecial (xlPasteValuesAndNumberFormats)
                    Worksheets("Truck_Analysis").Range("K" & lastrow + 1).PasteSpecial (xlPasteFormats)
                    Worksheets("Truck_Analysis").Range("K" & lastrow + 1).PasteSpecial (xlPasteComments)
                End If
            Next j
        End If
    End With
Next i

With Worksheets("Truck_Analysis")
    lrow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Sort.SortFields.Add Key:=Range("B1:B" & lrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With .Sort
        .SetRange Range("A1:K" & lrow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    .Range("A1:K" & lrow).Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(5, 7), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
        
    lrow = .Range("B" & .Rows.Count).End(xlUp).Row
    
    For i = 5 To lrow
        If .Range("B" & i).Value Like "*Total" And .Range("B" & i).Value <> "Grand Total" Then
            .Range("H" & i).FormulaR1C1 = "=IF(RC[-1]="""","""",RC[-3]/RC[-1])"
        ElseIf .Range("C" & i).Value = "Grand Total" Then
            .Rows(i).Font.Bold = True
            .Rows(i).Font.Color = -16776961
            .Range("H" & i).FormulaR1C1 = "=IF(RC[-1]="""","""",RC[-3]/RC[-1])"
        End If
    Next i
    
    .Cells.EntireColumn.AutoFit
        
    With .Range("A1:K" & lrow)
        .Font.Size = 8
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        With .Borders()
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
    End With
    
End With

Application.ScreenUpdating = True

End Sub
Hi can anyone help me with these codes. For some reason they are now taking forever to run. I am not sure it even finishes because i cancel after about 45minutes.

Thanks