Cut content to next row maintaining other content in range - excel

Question

I want to cut the cells present from the cells in E1:G1 and add it to D2 and copy the cells in range present in A1:C1 to the next row,
and do that to next rows and so on in which they have content from the columns E to G.
I've already tried to use the "Data - Text to Columns" in Excel but I can't use that in order to copy to rows...
What I'm trying to obtain is in this format, but I'm having a hard time finding VBA code in order to do this.

Answer 1

You could try:
Option Explicit
Sub test()
Dim LastRow As Long, LastColumn As Long, i As Long, y As Long
Dim Avalue As String, BValue As String, Cvalue As String
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = LastRow To 1 Step -1
Avalue = .Range("A" & i).Value
BValue = .Range("B" & i).Value
Cvalue = .Range("C" & i).Value
LastColumn = .Cells(i, .Columns.Count).End(xlToLeft).Column
If LastColumn > 4 Then
For y = LastColumn To 5 Step -1
.Rows(i + 1).EntireRow.Insert
.Cells(i + 1, 1).Value = Avalue
.Cells(i + 1, 2).Value = BValue
.Cells(i + 1, 3).Value = Cvalue
.Cells(i, y).Cut .Cells(i + 1, 4)
Next y
End If
Next i
End With
End Sub
Array Version
Option Explicit
Sub test()
Dim LastRow As Long, LastColumn As Long, i As Long, y As Long
Dim Avalue As String, BValue As String, Cvalue As String
Dim ABCvalues As Variant
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = LastRow To 1 Step -1
ABCvalues = .Range("A" & i & ":C" & i).Value
LastColumn = .Cells(i, .Columns.Count).End(xlToLeft).Column
If LastColumn > 4 Then
For y = LastColumn To 5 Step -1
.Rows(i + 1).EntireRow.Insert
.Range("A" & i + 1 & ":C" & i + 1).Value = ABCvalues
.Cells(i, y).Cut .Cells(i + 1, 4)
Next y
End If
Next i
End With
End Sub