Hi Shahid!
Do you need a general approach like below?
Sub test()
Dim arrOri, arrRst, arrTmp, i&, j&, r&, s$
arrOri = Sheets(1).[a1].CurrentRegion
ReDim arrRst(1 To UBound(arrOri) + 100, 1 To 3)
For i = 1 To UBound(arrOri) Step 4
r = r + 1
If IsNumeric(arrOri(i, 1)) Then
arrRst(r, 1) = arrOri(i, 1)
arrRst(r, 2) = arrOri(i + 1, 1)
Else
arrRst(r, 2) = arrOri(i, 1)
arrRst(r, 1) = arrOri(i + 1, 1)
End If
arrRst(r, 3) = arrOri(i + 3, 1)
s = Replace(arrOri(i + 2, 1), ":", "")
s = Application.Trim(s)
arrTmp = Split(s, " ")
For j = 0 To UBound(arrTmp) Step 2
r = r + 1
arrRst(r, 2) = arrTmp(j)
arrRst(r, 3) = arrTmp(j + 1)
Next j
Next i
Sheets(2).[a1].Resize(r, 3) = arrRst
End Sub