VBA assistance to copy entire row to row below not just cell

[tyantorno]

Hello,

I have code that split out cells with semi colon and copies them to cell below.
e.g.

row1 a;b xxx
row 2 c xxx

run code and receive

row 1 a xxx
row 2 b no row data here
row 3 c xxx

Here is the code. The only problem as you can see above is it is only copying cell down in column a and not entire row of data.

Sub CopySemi()
Dim ary As Variant
Dim cnt As Long
Dim lastrow As Long
Dim i As Long

With ActiveSheet

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = lastrow To 1 Step -1

ary = Split(.Cells(i, "A"), ";")
cnt = UBound(ary) - LBound(ary) + 1
If cnt > 1 Then

.Rows(i + 1).Resize(cnt - 1).Insert
.Cells(i, "A").Resize(cnt) = Application.Transpose(ary)
End If
Next i
End With
End Sub

Any insight would be greatly appreciated. Thank you.:banghead:

 

[Brianwarnock]

add th red statements

Brian

Sub CopySemi()
Dim ary As Variant
Dim cnt As Long
Dim lastrow As Long
Dim i As Long

With ActiveSheet

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = lastrow To 1 Step -1

ary = Split(.Cells(i, "A"), ";")
cnt = UBound(ary) - LBound(ary) + 1
If cnt > 1 Then
[COLOR="red"].Rows(i).Copy[/COLOR]
.Rows(i + 1).Resize(cnt - 1).Insert
.Cells(i, "A").Resize(cnt) = Application.Transpose(ary)
End If
Next i
End With
[COLOR="Red"]Application.CutCopyMode = False[/COLOR]
End Sub

 

[tyantorno]

Hello Brian,

Thank you so much, that worked perfectly. You are very helpful. Have a wonderful weekend! Tom