Réorganisation cellules pour publipostage

Question

Pour un projet de publipostage, il faudrait pour créer ma base de données que je parvienne à réorganiser des adresses récupérées dans un fichier WORD d'étiquettes. Lorsque je les copie sous EXCEL, les adresses sont sous 4 cellules en lignes max. Mais moi je souhaiterais les avoir sous 4 cellules en colonne... Je vous joint mon fichier avec en feuil1 la base de départ après collage des étiquettes et en feuil2 le résultat attendu. Merci d'avance pour votre aide précieuse. Bonne journée...

fred2406 · Answer

J'ai fait un essais mais cela est compliquer cartes données ne sont pas structurées de la même façon exemple : Dans les deux premières communes il y a cette configuration : une ligne vide pour l'adresse et donc le code postal se trouve sur la 4e ligne mais dans les deux communes suivantes, il y a une boite postale suivi d'une ligne vide et le code postal se trouve sur la 5e ligne,..... et cela est vrai un certain nombre de fois dans ton fichier j'ai donc fait quelques chose avec deux propositions, mais dans les deux cas il reste du boulot a la main a faire .... voir les resultats dans les feuilles 3 et 4 fred Re une autre possibilité là il y a plus que deux/trois erreurs pour les adresses dont le numéro de la rue est suppérieur à 1000 comme qui le met sur deux lignes .... a+ fred...

fred2406 · Answer

Re après vérification il y aussi au moins une commune qui n'a pas la même structure

Cette entité est sur 6 lignes et non pas sur 5 lignes...

Monsieur Le Président
C.D.C. Rhône-Crussol
1278 rue Henri Dunant
B.P. 249
07502 GUILHERAND-GRANGES Cédex

si cela convient

merci

Fred

pour changer la feuille de destination : changer dans le code "feuil5" par le nom de la feuille désirée (qui doit existée évidemment!!)

Sub reorganisation()
Dim i, lg As Long
Dim col, Indexcol As Byte
lg = 1
Indexcol = 1

With Sheets("feuil1")
    For col = 1 To 3 Step 2
        For i = 1 To .Cells(.Rows.Count, col).End(xlUp).Row
            If IsNumeric(Left(LTrim(.Cells(i, col)), 5)) Then
                Sheets("feuil5").Cells(lg, 4) = LTrim(CStr(.Cells(i, col)))
                lg = lg + 1
                Indexcol = 1
            Else
                If LTrim(CStr(.Cells(i, col))) <> "" Then Sheets("feuil5").Cells(lg, Indexcol) = LTrim(CStr(.Cells(i, col))): Indexcol = Indexcol + 1
            End If
        Next i
    Next col
End With
End Sub