Giúp công thức kiểm tra mất thời gian và thêm dòng trong vba!!!

[nguyenanhdung8111982]

tôi có đoạn code như dưới sau khi xử lý từ file gốc, nhưng khi chạy xong tôi phát hiện là thời gian bị mất không liên tục.
ví dụ như hình dưới:
9:46:20 bí mất giây 21.
9:46:25 bị mất giây 26, 27
tôi muốn thêm dòng bằng cách sao chép dòng trên và cộng thêm 1s.
Link file: https://drive.google.com/file/d/1mUcH4uzVjOPfSpOpnlDz6-_HNYnEpB_F/view?usp=sharing

Sub ProcessMultipleFiles()
Dim FolderPath As String, FilePath As String, NewFileName As String
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Clear
        .Filters.Add "CSV (MS-DOS)", "*.csv"
        If .Show Then
            FolderPath = FSO.GetParentFolderName(.SelectedItems(1)) & "\"
            For i = 1 To .SelectedItems.Count
                FilePath = .SelectedItems(i)
                NewFileName = FSO.GetBaseName(FilePath)
                NewFileName = Left(NewFileName, Len(NewFileName) - 4) & "_N.csv"
                FSO.CopyFile FilePath, FolderPath & NewFileName, True
                CSVAmend2 FolderPath, NewFileName
            Next
        End If
    MsgBox "Ho" & ChrW(224) & "n Th" & ChrW(224) & "nh !!!"
    End With
   End Sub
   
    
Sub CSVAmend2(FolderPath As String, FileName As String)

    Dim wb As Workbook, ws As Worksheet, rng As Range, headers As Variant

    headers = Array("ID", "trksegID", "lat", "lon", "ele", "time", "time_N", "Heading")

    'open file (immediate save not needed)

    'Set wb = Workbooks.Open("D:\test_file\test\20200310_07_002_QTB_GS023662-gps.csv")

    Set wb = Workbooks.Open(FolderPath & FileName)

    'wb.SaveAs ("D:\test_file\test\20200310_07_002_QTB_GS023662.csv")

    Set ws = wb.Sheets(1)

    Set rng = ws.Range("A2", ws.Range("A" & ws.Rows.Count).End(xlUp))
    'add time columns
         With rng.Offset(, 8)
        .Formula = "=F2"
        .Value = .Value
        .Offset(, 8).Value = .Value
        
        .Formula = "=A2"
        .Value = .Value
        .Offset(, 6).Value = .Value
         .Offset(, 6).NumberFormat = "yyyy-mm-dd hh:mm:ss"
        
        .Formula = "=A2+ TIME(7,0,0)"
        .Offset(, 7).Value = .Value
        .Offset(, 7).NumberFormat = "yyyy-mm-dd hh:mm:ss"
      
     
    End With

    'add ID columns

    ws.Range("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    rng.Formula = "=row()-1"

    rng.Offset(, 1).Value = 1

    'delete columns not required and insert headers

    ws.Range("F:O").Delete Shift:=xlToLeft

    ws.Range("A1:H1").Value = headers

    ActiveSheet.Range("A1:H50000").RemoveDuplicates Columns:=7, Header:=xlYes

    'save and close

    'wb.Save

    wb.Close SaveChanges:=True                        'False
 

End Sub

hình kết quả mong muốn

trân trọng cám ơn!!!