It's Step1_7 that's the issue, correct?
Try this:
Code:
Sub Step1_7()
Dim ary() As String
Dim cnt As Long
Dim LastRow As Long
Dim i As Long
With Worksheets("Sheet2")
LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
For i = LastRow To 1 Step -1
ary() = Split(.Cells(i, "E"), "; ") ' Added space so can copy AJ-JEFF to all rows
' ary = Split(.Cells(i, "F"), ";") '' If use ";" then only copies first row
cnt = UBound(ary()) - LBound(ary()) + 1
If cnt > 1 Then
.Rows(i).Copy ' This was added to copy row
.Rows(i).Font.Color = vbGreen
.Rows(i + 1).Resize(cnt - 1).Insert
.Cells(i, "E").Resize(cnt) = Application.Transpose(ary())
End If
Next i
End With
Application.CutCopyMode = False ' This was added when copy and paste may always need this
Call Step1_8
End Sub
Bookmarks