Split Single Row into Multiple Rows

This macro will work with your given data, try this on a small subset of your data. I would recommend you only run this on COPIES of your data.

Option Explicit

Sub SplitEDRows()
Dim LR As Long, Rw As Long, RwsADD As Long, NewRw As Long

LR = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False

For Rw = LR To 2 Step -1
    RwsADD = WorksheetFunction.CountA(Range("P" & Rw).Resize(, 38))
    If RwsADD > 0 Then
        RwsADD = WorksheetFunction.Ceiling(RwsADD / 2, 1)
        Rows(Rw).Copy
        Rows(Rw + 1).Resize(RwsADD).Insert xlShiftDown
        For NewRw = 1 To RwsADD
            Range("N" & Rw).Offset(, NewRw * 2).Resize(, 2).Copy Range("N" & Rw + NewRw)
        Next NewRw
    End If
Next Rw

Range("P:BA").Delete xlShiftToLeft
Application.ScreenUpdating = True
End Sub

I just noticed there are a lot of times missing in the mass data, so the macro above, which is faster, won't work. We have no choice but to check every cell on every row. Use this instead:

Option Explicit

Sub SplitEDRows()
Dim LR As Long, Rw As Long, RwsADD As Long, NewRw As Long, COL As Long

LR = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False

For Rw = LR To 2 Step -1
    For COL = 52 To 16 Step -2
        If Cells(Rw, COL) <> "" Then
            Rows(Rw).Copy
            Rows(Rw + 1).Insert xlShiftDown
            Cells(Rw, COL).Resize(, 2).Copy Cells(Rw + 1, "N")
        End If
    Next COL
Next Rw

Range("P:BA").Delete xlShiftToLeft
Application.ScreenUpdating = True
MsgBox "Done"
End Sub

Yes, the original code worked, but due to the missing timestamps sprinkled throughout your data you WERE missing line of data in the results. The second macro dealt with that properly.

In either case, if that takes care of your original question, please select Thread Tools from the menu link above and mark this thread as SOLVED. Thanks.