VBA code to copy and paste row based on certain criteria

[mancubus]

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])"