XL 2010 Regrouper plusieurs colonnes en une seule sans vides sans doublons

job75 à dit:

Bonjour djamal74, Bruno,

Voyez le fichier joint et cette macro dans le code de la feuille :

VB:

Private Sub Worksheet_Change(ByVal target As Range)
Dim d As Object, tablo, i&, j%, x$
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
With [Tableau1] 'tableau structuré
    tablo = .Resize(, 3) 'matrive, plus rapide
    For i = 1 To UBound(tablo)
        For j = 1 To 3
            x = tablo(i, j)
            If x <> "" Then d(x) = d(x) + 1
    Next j, i
    '---restitution---
    Application.ScreenUpdating = False
    Application.EnableEvents = False 'désactive les évènements
    .AutoFilter: .AutoFilter 'si le tableau est filtré
    .Columns(4) = "": .Columns(5) = "" 'RAZ
    If d.Count Then
        .Columns(4).Resize(d.Count) = Application.Transpose(d.keys)
        .Columns(5).Resize(d.Count) = Application.Transpose(d.items)
        .Columns(4).Resize(, 2).Sort .Columns(4), xlAscending, Header:=xlYes 'tri alphabétique
    End If
    Application.EnableEvents = True 'réactive les évènements
End With
End Sub

Elle se déclenche quand on modifie ou valide une cellule quelconque.

A+

Cliquez pour agrandir...