Macro VBA - Fusion Doublon et suppression ligne

Bonjour à tous,

Je me permets de venir vous embêter car je n'arrive pas à faire ma macro, je m'explique :

J'ai un tableau comportant des bus à créer, modifier, supprimer sur plusieurs dates. Seulement, j'ai les mêmes modifications/suppressions/créations sur plusieurs dates mais il y a une ligne différente pour chacune de ces dates. J'aimerais si possible regrouper l'ensemble de ces dates en conservant l'ensemble des données du tableau, exemple :

Bus 1 le 16/06

Bus 1 le 17/06

Bus 1 le 18/06

Transformé en :

Bus 1 16/06 + 17/06 + 18/06 (sur une même ligne)

De plus dans ce tableau j'ai dans la première colonne au lieu du numéro de bus écrit "ligne à supprimer" et j'aimerais que la macro supprime ces lignes.

Je vous joint mon tableau en exemple.

Merci d'avance de votre aide.

Salut swol,

quelque chose comme ça?

La macro se lance quand tu cliques en [A1]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
If Not Intersect(Target, Range("A1")) Is Nothing Then
    For x = 1 To Range("A" & Rows.Count).End(xlUp).Row - 1
        For y = Range("A" & Rows.Count).End(xlUp).Row To x + 1 Step -1
            If Cells(x, 1) = Cells(y, 1) Then
                Cells(x, 2) = Cells(x, 2) & " + " & Cells(y, 2)
                Rows(y).Delete shift:=xlUp
            End If
            If Cells(y, 1) = "Ligne à supprimer" Then Rows(y).Delete shift:=xlUp
        Next
    Next
    Columns("B:B").AutoFit
End If
'
End Sub

A+

Bonjour,

Merci pour cette macro oui c'est tout à fait ça par contre j'ai un soucis j'aimerais que les lignes qui sont fusionnées soit stricement identitique sauf la date.

Cependant, lorsque j'ai énormement de données la macro est lente et se mets à bug, est-ce normal ?

Merci encore pour ce travail.

Yann

Salut Yann,

pour la rapidité, dans un premier temps, on peut ajouter ceci...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
Application.EnableEvents = False
Application.ScreenUpdating = False
'
If Not Intersect(Target, Range("A1")) Is Nothing Then
    For x = 1 To Range("A" & Rows.Count).End(xlUp).Row - 1
        For y = Range("A" & Rows.Count).End(xlUp).Row To x + 1 Step -1
            If Cells(x, 1) = Cells(y, 1) Then
                Cells(x, 2) = Cells(x, 2) & " + " & Cells(y, 2)
                Rows(y).Delete shift:=xlUp
            End If
            If Cells(y, 1) = "Ligne à supprimer" Then Rows(y).Delete shift:=xlUp
        Next
    Next
    Columns("B:B").AutoFit
End If
'
Application.EnableEvents = True
Application.ScreenUpdating = True
'
End Sub

Par contre, ceci, je ne comprends pas. Explique!

j'aimerais que les lignes qui sont fusionnées soit stricement identitique sauf la date

A+