Align alike cells in different columns and add blanks where necessary

I've included sample data and the code that is so close to working... The code inserts a blank cell in Column B between 150637 & 150639 to align these numbers since 150638 is missing from Column B but present in Column H. I need blank cells in Columns A-F (rather than B only) so that attribute data remains aligned across these rows . I'm hoping for slight modification of code to meet needs. Any help would be appreciated!

Thanks!
Kelly

A B C D E F G H I J
845 150637 63 845 150637
846 150639 6.3 846 150638
847 150644 17.2 847 150639
848 150645 .99 848 150644

Sub AlignedSort()

Dim iRow As Long

'sort the two columns ascending
Range("B3", [B65536].End(xlUp)).Sort Key1:=[b1]
Range("H3", [H65536].End(xlUp)).Sort Key1:=[h1]

iRow = 2

Do Until IsEmpty(Cells(iRow, 2)) Or IsEmpty(Cells(iRow, 8))

If Cells(iRow, 2) < Cells(iRow, 8) Then
Cells(iRow, 8).Insert xlShiftDown
ElseIf Cells(iRow, 2) > Cells(iRow, 8) Then
Cells(iRow, 2).Insert xlShiftDown
End If

iRow = iRow + 6

Loop

End Sub

Sample worksheets attached, didn't realize my table looked so bad.