Excel Macro Copy Content in new row

[dummyagain]

I would like to write a macro to copy a cell value to a new row.

Example
acol1 acol2 acol3 acol4 acol5 acol6 acol7
bcol1 bcol2 bcol3 bcol4 bcol5 bcol6
ccol1 ccol2 ccol3 ccol4 ccol5 ccol6 ccol7
dcol1 dcol2 dcol3 dcol4 dcol5

i would like to do sth that all the cell from col6 to col9 will go to the new row with other values remain the same.

The result will be sth like
acol1 acol2 acol3 acol4 acol5
acol1 acol2 acol3 acol4 acol6
acol1 acol2 acol3 acol4 acol7
bcol1 bcol2 bcol3 bcol4 bcol5
bcol1 bcol2 bcol3 bcol4 bcol6
ccol1 ccol2 ccol3 ccol4 ccol5
ccol1 ccol2 ccol3 ccol4 ccol6
ccol1 ccol2 ccol3 ccol4 ccol7
dcol1 dcol2 dcol3 dcol4 dcol5

Here is my code

Sub ArrangeTool()

Dim NoOfRecord As Integer

NoOfRecord = ActiveSheet.UsedRange.Rows.Count

For i = 1 To NoOfRecord
For j = 6 To 10
If Not (IsEmpty(Cells(i, j))) Then
Cells(i, 1).EntireRow.Insert shift:=xlDown
ActiveCell(i, 1).Select
NoOfRecord = NoOfRecord + 1
If (j = 6) Then
Cells(i + 1, 1).Value = Cells(i, 1).Value + "A"

ElseIf (j = 7) Then
Cells(i + 1, 1).Value = Cells(i, 1).Value + "B"

ElseIf (j = 8) Then
Cells(i + 1, 1).Value = Cells(i, 1).Value + "C"

ElseIf (j = 9) Then
Cells(i + 1, 1).Value = Cells(i, 1).Value + "D"

ElseIf (j = 10) Then
Cells(i + 1, 1).Value = Cells(i, 1).Value + "E"

End If
Cells(i + 1, 2).Value = Cells(i, 2).Value

Cells(i + 1, 3).Value = Cells(i, 3).Value

Cells(i + 1, 4).Value = Cells(i, 4).Value

Cells(i + 1, 5).Value = Cells(i, 5).Value

Cells(i + 1, 6).Value = Cells(i, j).Value
Cell(i, j).Value = ""
End If
Next j
Next i
End Sub

there are some problems..... but i dont know how to correct it, pls help.