First, you must empty range A3:B4, because these cells are duplicates (from A2:B2).
Then you can run this macro :
Sub Test()
Dim a, b(1 To 1000000, 1 To 1) As String, pb As Long
With Sheets("30EL")
a = .Range("A1").CurrentRegion.Value
Rec a, b, pb, 1, ""
.Range("L1").Resize(pb).Value = b
End With
End Sub
Private Sub Rec(ByRef a, ByRef b, ByRef pb As Long, ByVal pCol As Long, ByVal strTemp As String)
Dim i As Long
For i = 2 To UBound(a, 1)
If Len(a(i, pCol)) Then
If pCol < UBound(a, 2) Then
Rec a, b, pb, pCol + 1, strTemp & a(i, pCol)
Else
pb = pb + 1
b(pb, 1) = strTemp & a(i, pCol)
End If
End If
Next i
End Sub
Bookmarks