Help me insert subtotals on I:L my vba code below. It sorts and insets a blank row

[albertt]

Sub insertRows()
Dim mySector As String
Dim myDay As String
Dim myRange As Long
Dim counter As Long
Rows("1:7").Delete Shift:=xlUp
Cells.Select
Selection.Replace What:="label=", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="1800", Replacement:=" 1800", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="nil", Replacement:="0", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.AutoFilter
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
("D1:D19304"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
Selection.AutoFilter
End With
Range("A1").Select
myRange = Cells(Rows.Count, "A").End(xlUp).Row
For i = myRange To 2 Step -1
myDay = Cells(i, "A").Value
mySector = Cells(i, "D").Value
myDay = Right(myDay, 8)
If myDay Like "*23:00:00*" And mySector Like "*-3*" Then
Rows(i + 1).Insert
End If
Next i
End Sub