Sub FaireLaChose()
Dim i As Integer, j As Integer, k As Integer
Dim datas As Variant, res() As Variant, itm As Variant
With Sheets("fichier original")
datas = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
For i = 1 To UBound(datas)
'recherche d'une ligne commençant par une date
If datas(i, 1) Like "####/##/##*" Then
j = j + 1: ReDim Preserve res(1 To 5, 1 To j)
'eclater la ligne dans un tableau
itm = Split(datas(i, 1), ",")
'prendre le dernier élément du tableau comme non de ville
res(1, j) = itm(UBound(itm)): itm = ""
'Recherche du code postal
For k = 1 To 3
'Eviter le dépassement des limites de Datas (en fin de données)
If i + k > UBound(datas) Then Exit For
'Si code postal trouvé
If datas(i + k, 1) Like "#####*" Then
itm = datas(i + k, 1)
res(4, j) = Left(itm, 5)
res(5, j) = Right(itm, Len(itm) - 6)
Exit For
End If
Next k
'Suivant k récupérer l'adresse et le complément d'adresse
Select Case k
Case 2: res(2, j) = datas(i + 1, 1)
Case 3
res(2, j) = datas(i + 1, 1)
res(3, j) = datas(i + 2, 1)
End Select
End If
Next i
'Resultat en Cellule A2:E? de la feuille destination
Sheets("ce que je voudrais").Cells(2, 1).Resize(UBound(res, 2), 5) = Application.Transpose(res)
End Sub