welcome to the forum.

not an elegant one but i think it works...

Dim i As Long, j As Long, rws As Long, LR As Long
LR = Cells.Find("*", , , , xlByRows, xlPrevious).Row
For i = LR To 2 Step -1
With Cells(i, 1)
If .Value > 1 Then
rws = Cells(i, Columns.Count).End(xlToLeft).Column - 1
Rows((i + 1) & ":" & (i + rws)).Insert
For j = 1 To rws
.Offset(j, j).Value = Cells(i, j + 1).Value
Next
End If
End With
Next
LR = Cells.Find("*", , , , xlByRows, xlPrevious).Row
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Application.CountA(Rows(i)) = 0 Then
Rows(i).Delete
LR = LR - 1
End If
Next
Range("A2:A" & LR).FormulaR1C1 = "=COUNTA(RC[1]:RC[20])"