There is probably a formula way to do this which would be faster. Either way here you go.
Sub CombineCells()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
Dim rCell As Range, rng As Range
Dim strValue As String
Application.ScreenUpdating = False
For Each rCell In ws.Range("A1:A" & ws.Range("A" & Rows.Count).End(xlUp).Row)
strValue = ""
For Each rng In rCell.Resize(1, 9)
If rng.Value <> "" Then
If strValue = "" Then
strValue = rng.Value
Else
strValue = strValue & ";" & rng.Value
End If
End If
Next rng
ws.Range("N" & rCell.Row).Value = strValue
Next rCell
Application.ScreenUpdating = True
End Sub
Bookmarks