Excel: multicellules à remettre dans une seule cellule

PierreC1977 Messages postés 4 Date d'inscription   Statut Membre Dernière intervention   -  
PierreC1977 Messages postés 4 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,

Je m'excuse d'avance car le sujet a surement déjà été traité dans votre forum mais mes recherches sur internet n'ont rien donné. (mauvais intitulé?)

J'ai un export EXCEL d'environ 6000 lignes mais celui-ci comporte des données avec des cellules réparties sur plusieurs lignes (voir capture d'écran)



Je souhaite CONCATÉNER /fusionner/supprimer pour avoir en final un fichier avec à chaque fois sur une seule ligne avec l'intitulé A et les autres colonnes fusionnées sans pertes.

Exemple: concaténation avec retour ligne des cellules A5 à A8, C5 à C8, D5 à D8.

Une idée de code VBA?

Merci pour votre aide.

Pierre
A voir également:

3 réponses

Réponse 1 / 3
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Bonjour,

Plutôt qu'une image, un fichier exemple d'une trentaine de lignes serait un bon départ...
Tu laisses 30 et quelques lignes de ton fichier comme il est ainsi que ce que tu veux obtenir à la fin.

Pour joindre un fichier, il faut passer par cjoint.fr créer un lien vers ton fichier et revenir ici coller le lien dans ta réponse.
0
PierreC1977 Messages postés 4 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour Franck,
Merci pour les conseils et les messages.
Je complète ma demande rapidement
0
Réponse 2 / 3
PierreC1977 Messages postés 4 Date d'inscription   Statut Membre Dernière intervention  
 
Voici un exemple avec la situation incorrecte et la situation corrigée pour compléter ma question.

https://www.cjoint.com/c/EFimUsUtvhq
0
Réponse 3 / 3
Frenchie83 Messages postés 2240 Date d'inscription   Statut Membre Dernière intervention   338
 
Bonjour
A essayer 
Sub MiseEnForme()
    Application.ScreenUpdating = False
    'Suppression de la fusion des cellules
    Columns("A:E").UnMerge
    DerLig = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
    
    'Remplissge colonne D
    For i = 2 To DerLig
        If Cells(i, 1) <> "" Then
            LigDep = i
        Else
            'vérifie si le texte trouvé est déjà présent dans les cellules destinations
            ValColD = InStr(1, Cells(LigDep, 4), Cells(i, 4), 1)
            If ValColD = 0 Then Cells(LigDep, 4) = Cells(LigDep, 4) & Chr(10) & Cells(i, 4) & ","
            
            ValColE = InStr(1, Cells(LigDep, 5), Cells(i, 5), 1)
            If ValColE = 0 Then Cells(LigDep, 5) = Cells(LigDep, 5) & Chr(10) & Cells(i, 5) & ","
        End If
    Next i
    
    'Suppression des lignes inutiles
    For i = DerLig To 2 Step -1
        If Cells(i, 1) = "" Then Rows(i).EntireRow.Delete
    Next i
        
    'suppression des espaces, virgules et retour chariot inutiles
    For i = 2 To [A100000].End(xlUp).Row
        For j = 4 To 5
            Cells(i, j) = LTrim(Cells(i, j))
            If Left(Cells(i, j), 2) = Chr(10) & "," Then Cells(i, j) = Right(Cells(i, j), Len(Cells(i, j)) - 3)
            If Left(Cells(i, j), 1) = "," Then Cells(i, j) = Right(Cells(i, j), Len(Cells(i, j)) - 1)
        Next j
    Next i
    
    'suppression des virgules doubles
    Columns("D:E").Select
    Selection.Replace What:=",,", Replacement:=",", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub

Cdlt
0
PierreC1977 Messages postés 4 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour Frenchie,

Merci pour votre réponse. Je vais l'essayer.
0