Fusion cellules conditionnelle avec préservation des données

[cathodique]

Bonjour,

Je tiens à remercier Jack2 et Job75 pour le coup de main sur ce fichier même. j'ai trouvé quelques pistes mais insuffisantes pour ce que je voudrais faire.

je voudrais compléter les codes de mon fichier pour fusionner les cellules la dernière colonne à l'identique que la colonne "A" mais en préservant le texte des cellules fusionnées.

ex: en feuille B, A7:A9 sont fusionnées donc M7:M9 à fusionnées (la dernière colonne peut variée) et remettre les données qui se trouvées en Dercol7, Dercol8 et Dercol9. Sauf si les valeurs sont identiques comme pour A10:A11, on ne mettra qu'une seule fois la données (comme dans excel, il ne reprend que la valeur du haut). Et ce pour les 3 feuilles A, B et C.

En espérant avoir été clair. je vous remercie pour votre aide.

Cordialement,

 

[CBernardT]

Re : Fusion cellules conditionnelle avec préservation des données

Bonsoir,

Une macro qui devrait aller :

Sub FusionObs()
Dim Derlig As Integer, Plage As Range, i As Integer, k As Integer, Obsers As String, Sit As String


Derlig = Range("L50000").End(xlUp).Row
For i = 6 To Derlig
If Range("A" & i).MergeArea.Count > 1 Then
Set Plage = Range("A" & i).MergeArea
Plage.Select
Plage.UnMerge
Obsers = ""
For k = i To i + Plage.Count - 1
Obsers = Obsers & Cells(k, 1).Offset(0, 12) & " "
Cells(k, 1).Offset(0, 12).ClearContents
Next k
Plage.Offset(0, 12).Merge
Plage.Offset(0, 12) = Obsers
Plage.Merge
i = i + Plage.Count - 1
Set Plage = Nothing
End If
Next i
End Sub

 

[cathodique]

Re : Fusion cellules conditionnelle avec préservation des données

Bonjour Bernard,

Je te remercie pour ton code. Je vais essayer de l'adapter pour mon cas. Car le code doit s’exécuter pour 3 feuilles A, B et C. La plage de données est variable (Nombre de lignes et colonnes).

Merci beaucoup, je m'en inspire pour mon problème, à tantôt pour les nouvelles.

Bonne journée.

Cordialement,

PS: je suppose que ton code est pour la feuille "B", je te confirme qu'il remet les données dans les cellules fusionnées, mais je voulais qu'il ne remet pas les valeurs en double (s'il y a "RAS" sur toutes les lignes à fusionner, il ne la remet qu'une seule fois). je tente de l'adapter pour les 3 feuilles. Merci.

 

[cathodique]

Re : Fusion cellules conditionnelle avec préservation des données

Re, Bernard,

Voilà, j'ai adapté ton code afin qu'il s"exécute pour mes 3 feuilles. J'avoue que je n'ai pas bien compris le processus du code pour la reprise des valeurs. j'ai fait des tests ainsi, et ça donne de bons résultats. Comment puis-je faire pour éliminer les "doublons" (c-à-d avoir 2 fois la même observation comme par exemple: RAS RAS)?

Vu mon niveau ça me dépasse. Je compte sur votre aide. En vous remerciant par avance.
Le code actuel qui fonctionne bien ci-dessous:

Sub FusionObs()
Dim Derlig As Integer, Dercol As Integer, Plage As Range, i As Integer, k As Integer, Obsers As String, Sit As String
Dim Tp
Dim Ind As Byte
Application.ScreenUpdating = False
 
Tp = Array("A", "B", "C")
 
For Ind = 0 To 2
    With Worksheets(Tp(Ind))
    'Sheets(Tp(Ind)).Activate 'juste pour suivre l'execution
    
    Dercol = .Cells(4, .Columns.Count).End(xlToLeft).Column
    Derlig = .Cells(Application.Rows.Count, 4).End(xlUp).Row

For i = 6 To Derlig
    If Range("A" & i).MergeArea.Count > 1 Then
        Set Plage = .Range("A" & i).MergeArea
        Plage.Select
        Plage.UnMerge
        Obsers = ""
        For k = i To i + Plage.Count - 1
            Obsers = Obsers & Cells(k, 1).Offset(0, Dercol - 1) & vbLf ' & " "
            Cells(k, 1).Offset(0, Dercol - 1).ClearContents
        Next k
        Plage.Offset(0, Dercol - 1).Merge
        Plage.Offset(0, Dercol - 1) = Obsers
        Plage.Merge
        i = i + Plage.Count - 1
        Set Plage = Nothing
    End If
Next i
    End With
Next Ind
Application.ScreenUpdating = True
MsgBox "Terminé!"
End Sub

Cordialement,