XL 2013 (RESOLU) copier 4 listes dans une seule liste

[chaelie2015]

Bonsoir Forum
Je souhaite copier les 4 liste de 4 feuilles dans la feuille finale sans doublon et dans l'ordre.
Merci.

<Bon rétablissement à Gérard (alias Job75)>​

 

[chaelie2015]

Bonsoir Staple1600, Jacky67 et TooFatBoy
Merci pour ces détails, c'est parfait.
@ JM: merci pour la réponse.
Bonne soirée

 

[Staple1600]

@Jacky67
Dès que je croise un DG, je me crispe
Alors un Directeur Général des Directions, je perds mes moyens

Nonobstant ma bévue, on doit pouvoir faire un truc avec un Dictionary et tuttti quanti

 

[Staple1600]

@chaelie2015
Donc il ne fallait pas trier ni par l'année, ni par le trimestre ?

 

[chaelie2015]

@chaelie2015
Donc il ne fallait pas trier ni par l'année, ni par le trimestre ?

Re
non, il faut trier par année en premier lieu après par trimestre

3T 2020

4T 2022

1T 2023

2T 2023

3T 2023

4T 2023

 

[Staple1600]

Re

@chaelie2015
Bah c'est le tri que fait le code du message#4, non ?
(un tri chronologique)


Sinon pour le fun
Avec l'array, mais sans tri

Sub AR_Ray_Charles()
Dim vArr
With Application
    vArr = _
    Split(Join(.Transpose(Feuil1.Range("C2", Feuil1.Cells(Rows.Count, "C").End(3))), "²") & "²" & _
    Join(.Transpose(Feuil2.Range("C2", Feuil2.Cells(Rows.Count, "C").End(3))), "²") & "²" & _
    Join(.Transpose(Feuil3.Range("C2", Feuil3.Cells(Rows.Count, "C").End(3))), "²") & "²" & _
    Join(.Transpose(Feuil4.Range("C2", Feuil4.Cells(Rows.Count, "C").End(3))), "²"), "²")
    Feuil5.Range("A2").Resize(UBound(vArr)).Value = .Transpose(vArr)
End With
Feuil5.Columns(1).RemoveDuplicates 1, 1
End Sub

 

[Staple1600]

Re

Ci dessous la version corrigée
(suite à la remarque de Jacky67)

Sub test_C()
Dim f As Worksheet, dl&
For Each f In Worksheets
If f.Name <> "Finale" Then
Set r = f.Columns("C:C").SpecialCells(xlCellTypeConstants, 2)
Set rr = r.Offset(1).Resize(r.Rows.Count - 1)
rr.Copy Sheets("Finale").Cells(Rows.Count, 1).End(3)(2)
End If
Next
With Sheets("Finale")
    .Columns("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
    .[B1] = "TRI"
    dl = .Cells(Rows.Count, 1).End(xlUp).Row
    .Range("B2:B" & dl).FormulaR1C1 = "=DATEVALUE(CHOOSE(LEFT(RC[-1])*1,""1/1/"",""1/4/"",""1/7/"",""1/10/"")&RIGHT(RC[-1],4))"
    .Range("A1:B" & dl).Sort key1:=.Range("B2"), Order1:=xlAscending, Header:=xlYes
    .Range("B:B").Clear
End With
End Sub

 

[chaelie2015]

Re

@chaelie2015
Bah c'est le tri que fait le code du message#4, non ?
(un tri chronologique)


Sinon pour le fun
Avec l'array, mais sans tri

Sub AR_Ray_Charles()
Dim vArr
With Application
    vArr = _
    Split(Join(.Transpose(Feuil1.Range("C2", Feuil1.Cells(Rows.Count, "C").End(3))), "²") & "²" & _
    Join(.Transpose(Feuil2.Range("C2", Feuil2.Cells(Rows.Count, "C").End(3))), "²") & "²" & _
    Join(.Transpose(Feuil3.Range("C2", Feuil3.Cells(Rows.Count, "C").End(3))), "²") & "²" & _
    Join(.Transpose(Feuil4.Range("C2", Feuil4.Cells(Rows.Count, "C").End(3))), "²"), "²")
    Feuil5.Range("A2").Resize(UBound(vArr)).Value = .Transpose(vArr)
End With
Feuil5.Columns(1).RemoveDuplicates 1, 1
End Sub

Re
je l'ai marquer comme solution

 

[Staple1600]

Re

@chaelie2015
[Pour infos]
Il faut prendre la macro du message#21
(car la feuille DGD était zappée)

 

[Staple1600]

Re

Une dernière pour la route
(J'ai juste un élagué le code)

Sub test_D()
Dim f As Worksheet, dl&
For Each f In Worksheets
    If f.Name <> "Finale" Then
        With f.Columns("C:C").SpecialCells(2, 2)
        .Offset(1).Resize(.Rows.Count - 1).Copy Sheets("Finale").Cells(Rows.Count, 1).End(3)(2)
        End With
    End If
Next
With Sheets("Finale")
    .Columns("A:A").RemoveDuplicates 1, 1: .[B1] = "TRI"
    dl = .Cells(Rows.Count, 1).End(xlUp).Row
    .Range("B2:B" & dl).FormulaR1C1 = "=DATEVALUE(CHOOSE(LEFT(RC[-1])*1,""1/1/"",""1/4/"",""1/7/"",""1/10/"")&RIGHT(RC[-1],4))"
    .Range("A1:B" & dl).Sort key1:=.Range("B2"), Order1:=1, Header:=1: .Range("B:B").Clear
End With
End Sub

 

[chaelie2015]

Re

@chaelie2015
[Pour infos]
Il faut prendre la macro du message#21
(car la feuille DGD était zappée)

RE
mais ça n'a pas fonctionné si je rajoute une feuille

 

[chaelie2015]

Re
et si je prend le code du message 4, ça fonctionne parfait

 

[TooFatBoy]

N'en jeté pas, oh ! gentilhomme, le tri sur les dates de notre ami JM est tout aussi méritoire, n'est-il pas ?

Ben c'est un tri aléatoire. Faut aimer, c'est particulier...
Pis surtout ça ne semble pas du tout correspondre à ce qui est donné en exemple dans le premier classeur.

Mais ça semble en revanche correspondre à la nouvelle volonté du demandeur.

non, il faut trier par année en premier lieu après par trimestre

Par contre, je ne comprends pas pourquoi les tableaux initiaux ne contiennent pas directement les bonnes valeurs...

 

[Staple1600]

@TooFatBoy
Do you see me? (cf message#12)

Le tri se fait bien par année, non ? puisqu'on va de 2019 à 2024
(voir tableau dans le message#10)

@chaelie2015
Comme je parlais tout à l'heure de Dictionary
Un macro avec un Dictionary
(mais sans tri)

Sub Test_E()
Dim x As Worksheet, rng As Range, k&, F As Worksheet: Set F = Sheets("Finale")
k = 1
For Each x In Worksheets
    If x.Name <> "Finale" Then
    x.Columns(3).Copy Sheets("Finale").Cells(1, k): k = k + 1
    End If
Next
Set dico = CreateObject("Scripting.Dictionary")
F.Cells(1).Resize(, 4) = "Liste Finale"
    For Each rng In F.Cells(1).CurrentRegion
        If rng.Value <> "" Then dico(rng.Value) = ""
    Next
F.Cells.Clear
F.Cells(1).Resize(dico.Count) = Application.Transpose(dico.Keys)
F.Cells(1).CurrentRegion.Borders.Value = 1
End Sub

 

[TooFatBoy]

@TooFatBoy
Do you see me?

No, I don't. And you, do you do you St Tropez ???

 

[Staple1600]

@TooFatBoy
Je me posais juste la question (rapport au Bonjour que je t'adressais dans ce douzième message)
C'est pas grave.

@chaelie2015
la macro du message#4 à un défaut (comme l'a soulevé Jacky67)
La macro du message#24 n'a plus ce défaut (normalement)
Je viens de faire le test en ajoutant une nouvelle feuille.
Elle est bien prise en compte.