Re,
Voici un code qui se suffit à lui-même (ne necessite pas de formules dans Excel)
J'ai traité également le "et" pour le dernier prénom.
Sub etiq()
Dim bi As Integer 'N° ligne bdd
Dim enfants As String
Dim Adr1 As String, Adr2 As String, Adr3 As String
Dim ei As Integer, ej As Byte
bi = 2
ei = 1
ej = 1
Worksheets.Add
With Columns("A:B").EntireColumn
.ColumnWidth = 49
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 6
End With
With Sheets("BDD brut étiquettes")
Do Until .Cells(bi, "E") = ""
Adr1 = UCase(.Cells(bi, "D")) & " " & .Cells(bi, "E")
Adr2 = .Cells(bi, "A")
Adr3 = .Cells(bi, "B") & " " & .Cells(bi, "C")
Do While .Cells(bi + 1, "D") = "" And .Cells(bi + 1, "E") <> ""
If .Cells(bi + 2, "E") <> "" And .Cells(bi + 2, "D") = "" Then
Adr1 = Adr1 & ", " & .Cells(bi + 1, "E")
Else
Adr1 = Adr1 & " et " & .Cells(bi + 1, "E")
End If
bi = bi + 1
Loop
Cells(ei, ej) = Adr1 & vbCrLf & Adr2 & vbCrLf & Adr3
ej = ej + 1
If ej = 3 Then
ej = 1
ei = ei + 1
End If
bi = bi + 1
Loop
End With
Rows("1:" & ei).RowHeight = 113.5
End Sub
Caillou