Sub concatenation() [COLOR="Green"]'Crédits à Wim Gielis[/COLOR]
Dim myArea As Range, myAreas As Areas, temp As String
With Range("A1", Range("A" & Rows.Count).End(xlUp))
On Error Resume Next
Set myAreas = .SpecialCells(2).Areas
If (myAreas Is Nothing) + (myAreas.Count = 1) Then Exit Sub
On Error GoTo 0
For Each myArea In myAreas
If myArea.Rows.Count > 1 Then
temp = Join(Evaluate("transpose(" & myArea.Address & ")"))
Else
temp = myArea.Value
End If
With myArea.Resize(1).Offset([COLOR="Blue"]myArea.Rows.Count[/COLOR], 1)
.Value = [COLOR="Blue"]Replace(temp, " ", ";")[/COLOR]
End With
Next
End With
End Sub