求excel合并单元格按时间自动排序VBA代码

Option Explicit

Sub Order()
Application.ScreenUpdating = False
Dim i, j As Integer
For i = 6 To [A65536].End(xlUp).Row Step 2
    If Cells(i, 1) < Cells(i - 2, 1) Then
        For j = i - 2 To 4 Step -2
            If Cells(i, 1) >= Cells(j - 2, 1) Then Exit For
        Next
        Rows(j).Insert
        Rows(j).Insert
        Range(i + 2 & ":" & i + 3).Copy
        Range(j & ":" & j + 1).PasteSpecial xlPasteAll
        Range(i + 2 & ":" & i + 3).Delete
    End If
Next
Range("A1").Select
Application.ScreenUpdating = True
End Sub