Microsoft 365 Macro aligner données identique

[netparty]

Bonjour à tous

Je suis à la recherche d'une macro permettant d'aligner et trier les valeurs de plusieurs colonne.

Je joint le fichier se sera plus claire pour comprendre ma demande

Merci d'avance

Bonne journée

 

[sylvanu]

Bonjour NetParty,
Un essai en Pj avec :

Sub Concatene()
    ' Figeage écran
    Application.ScreenUpdating = False
    ' Effacement matrice
    Range("N3:Q" & 1 + [N65500].End(xlUp).Row).ClearContents
    ' Copie des trois matrices d'entrée dans la matrice de sortie
    Range("N" & 1 + [N65500].End(xlUp).Row & ":N" & 1 + [N65500].End(xlUp).Row + [A65500].End(xlUp).Row - 3) = Range("A3:A" & [A65500].End(xlUp).Row).Value
    Range("N" & 1 + [N65500].End(xlUp).Row & ":N" & 1 + [N65500].End(xlUp).Row + [E65500].End(xlUp).Row - 3) = Range("E3:E" & [A65500].End(xlUp).Row).Value
    Range("N" & 1 + [N65500].End(xlUp).Row & ":N" & 1 + [N65500].End(xlUp).Row + [I65500].End(xlUp).Row - 3) = Range("I3:I" & [A65500].End(xlUp).Row).Value
    ' Suppression des doublons
    ActiveSheet.Range("$N$2:$N$" & [N65500].End(xlUp).Row).RemoveDuplicates Columns:=1, Header:=xlNo
    ' Tri par ordre alpha
    Tri
    ' Insere les formules de recherche et colle les valeurs
    DL = ActiveSheet.[N65500].End(xlUp).Row
    With ActiveSheet.Range("$O$3:$O$" & DL)
        .FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-1],R3C1:R65000C2,2,FALSE),"""")": .Value = .Value
    End With
    With ActiveSheet.Range("$P$3:$P$" & DL)
        .FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-2],R3C5:R65000C6,2,FALSE),"""")": .Value = .Value
    End With
    With ActiveSheet.Range("$Q$3:$Q$" & DL)
        .FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-3],R3C9:R65000C10,2,FALSE),"""")": .Value = .Value
    End With
End Sub
Sub Tri()
    DL = [N65500].End(xlUp).Row
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("N3:N" & DL) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange Range("N2:N" & DL): .Header = xlYes: .MatchCase = False
        .Orientation = xlTopToBottom: .SortMethod = xlPinYin: .Apply
    End With
End Sub

 

[pierrejean]

bonjour netparty

Un essai

 

[netparty]

Bonjour @sylvanu et @pierrejean

Merci à vous 2 pour vos fichiers.
Dans mon exemple je n'ai mis que 3 colonnes de données mais dans la réalité cela peut aller de 2 à 15 colonnes de données.
Alors je me demande si cela est possible de faire la même chose sans savoir à l'avance combien de colonne j'aurais.

Merci d'avance

bonne fin de journée

 

[pierrejean]

Re
Teste cette version

 

[netparty]

Re
Teste cette version

Bonjour pierrejean

Merci pour ton fichier il fonctionne parfaitement.
Est-il possible si j'ai plusieurs fois les même valeurs de les additionner ?

Bonne fin de journée

 

[pierrejean]

Re
A tester

 

[netparty]

Re
A tester

Bonjour pierrejean

Merci pour ton fichier c'est nickel