If I'm understanding you correctly try the following
Public Sub Test()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim LastRow As Long
Dim i As Long
Dim sCombine As String
sCombine = ""
LastRow = Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
For i = 2 To LastRow
A = Trim(Sheet1.Cells(i, "A"))
B = Trim(Sheet1.Cells(i, "B"))
C = Trim(Sheet1.Cells(i, "C"))
D = Trim(Sheet1.Cells(i, "D"))
If A <> "" Then
sCombine = A
Else
Exit Sub
End If
If B <> "" Then sCombine = B & "|" & sCombine
If C <> "" Then sCombine = C & "|" & sCombine
If D <> "" Then sCombine = D & "|" & sCombine
Sheet1.Cells(i, "E") = sCombine
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
or
Public Sub Test1()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim LastRow As Long
Dim i As Long
Dim sCombine As String
sCombine = ""
LastRow = Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
For i = 2 To LastRow
A = Trim(Worksheets("Name of sheet").Cells(i, "A"))
B = Trim(Worksheets("Name of sheet").Cells(i, "B"))
C = Trim(Worksheets("Name of sheet").Cells(i, "C"))
D = Trim(Worksheets("Name of sheet").Cells(i, "D"))
If A <> "" Then
sCombine = A
Else
Exit Sub
End If
If B <> "" Then sCombine = B & "|" & sCombine
If C <> "" Then sCombine = C & "|" & sCombine
If D <> "" Then sCombine = D & "|" & sCombine
Worksheets("Name of sheet").Cells(i, "E") = sCombine
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Note: You need to run the macro again every time you introduce a new row
Bookmarks