Sub JoinCells()
'SOURCE:http://www.ozgrid.com/VBA/VBALoops.htm
Dim rCells As Range
Dim rRange As Range
Dim rStart As Range
Dim strStart As String
Dim iReply As Integer
On Error Resume Next
'Allow user to nominate cells to join
'Permet à l'utilisateur d'indiquer la plage de cellules à concatener
Set rCells = Application.InputBox _
(Prompt:="Selectionnez la plage de cellules à concatener, svp," _
& "utilisez CTRL pour les celllules non-contigues.", _
Title:="CONCATENATION DE CELLULES", Type:=8)
If rCells Is Nothing Then 'Cancelled or mistake 'Annulation ou erreur
iReply = MsgBox("Selection invalide!", _
vbQuestion + vbRetryCancel)
If iReply = vbCancel Then
On Error GoTo 0
Exit Sub
Else
Run "JoinCells" 'Try again ' rééssayer
End If
End If
'Set range variable to first cell ' indiquer la première cellule
Set rStart = rCells(1, 1)
'Loop through cells chosen 'Boucle à travers les cellules choisies
For Each rRange In rCells
strStart = rRange 'parse cell content to a String
rRange.Clear 'Clear contents of cell ' effacement du contenu
'Replace the original contents of first cell with "", then _
join the text
'Remplacement du contenu original par "", puis concaténation du texte
rStart = Trim(Replace(rStart, rStart, "") & " " _
& rStart & "," & strStart)
Next rRange
On Error GoTo 0
End Sub
