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

chaelie2015

XLDnaute Accro
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)>

 

Pièces jointes

  • Charlie copie finale actes.xlsx
    12.8 KB · Affichages: 13
Dernière édition:
Solution
Re

@chaelie2015
Voici pour l'ordre
VB:
Sub test_B()
Dim f As Worksheet, dl&
For Each f In Worksheets
If Len(f.Name) = 2 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

Jacky67

XLDnaute Barbatruc
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
RE..
Ceci n'était pas précisé dans la demande ni démontré dans l'exemple donnée...
RE
mais ça n'a pas fonctionné si je rajoute une feuille
RE...
Aller, une dernière avant de rejoindre Morphée
Fonctionne avec feuille rajoutée vide
Un mixte JM & Jacky
Bonne nuit à tous
 

Pièces jointes

  • Charlie copie finale actes.xlsm
    27.3 KB · Affichages: 4

Staple1600

XLDnaute Barbatruc
[aparté]
@TooFatBoy
Comme disait les Qui
"See Me, Feel Me, Touch Me, Heal Me"
J'en suis point là mais j'eusse cru que vous m'auriez claqué la bise ;) suite à mes salutations à votre endroit.
;)
(Une vielle habitude qui me vient de l'XLD d'avant, d'avant Xenforo, où les vieux de la vieille se saluaient mutuellement)
[/aparté]

@chaelie2015
suggestion en finissant de passer
Tu pourrais mettre tout sur une seule feuille (en ajoutant une colonne)
Et ainsi avec un TCD, tu pourrais
- ne pas avoir de doublons (ou plutôt ne pas les afficher)
- splitter en N feuilles ta base
(le tout sans VBA)

@Jacky67
Je regarderai ta nouvelle PJ demain
Moi aussi je rejoins Morphée incessamment sous peu ;)
 

TooFatBoy

XLDnaute Barbatruc
J'en suis point là mais j'eusse cru que vous m'auriez claqué la bise ;) suite à mes salutations à votre endroit.
;)
N'était-ce pas de ta part une réponse à mon "bonjour" précédent (voir #11) ?
En tous les cas la logique le voudrait. ;)

J'essaye de ne rien claquer, pas même les portes, et j'essaye également de ne plus faire de bise depuis que j'ai chopé la COVID.
 

Staple1600

XLDnaute Barbatruc
Bonjour @chaelie2015 ,@Jacky67 ,@TooFatBoy , le fil


Pour les curieux et les 365ièmes
(à tester sur une copie du fichier exemple, sans feuille surnuméraire)
1) Effacer le contenu de la feuille Finale avant de tester
Code:
Sub Merci_O_365()
Dim x As Worksheet, k&, st_R$, dl&, F As Worksheet: Set F = Sheets("Finale")
k = 1
For Each x In Worksheets
    If x.Name <> "Finale" Then
    st_R = st_R & x.Name & "!" & x.Range("C2", x.Cells(Rows.Count, "C").End(3)).Address & ","
    End If
Next
formule = Mid(st_R, 1, Len(st_R) - 1)
F.[A2].Formula2 = "=VSTACK(" & formule & ")"
dl = F.Cells(Rows.Count, 1).End(3).Row
F.Range("B2:B" & dl).FormulaR1C1 = "=DATE(RIGHT(RC[-1],4),CHOOSE(LEFT(RC[-1])*1,1,4,7,10),1)"
F.Range("C2").Formula2 = "=SORT(UNIQUE(B2:B" & dl & "))"
With F.Range("D2:D" & F.Cells(Rows.Count, "C").End(3).Row)
    .Formula2 = "=CEILING(MONTH(C2)/3,1)&""T ""&YEAR(C2)"
    .Font.Bold = True
    .Interior.Color = vbYellow
    .Borders.Value = 1
End With
End Sub
NB: j'ai laissé les colonnes supplémentaires pour voir les formules
(que je découvre grâce à ce fil ;)
Merci @chaelie2015 et 365)

NB: Ceci n'est pas une solution mais un complément pour ceux qui passeront dans fil
(et qui tournent sous O365)
 

job75

XLDnaute Barbatruc
Bonjour le fil, le forum,

Voyez le fichier joint et cette macro qui utilise la commande Consolider et trie comme demandé :
VB:
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
If Not IsNumeric(CStr([BP!D2])) Then [BP!D2] = 0 'au moins une donnée à consolider
With [A2]
    .Consolidate Array("BP!R2C3:R100C4", "RP!R2C3:R100C4", "DGD!R2C3:R100C4", "RD!R2C3:R100C4"), LeftColumn:=True 'commande Consolider
    With .CurrentRegion.Resize(, 2)
        .Columns(2).Insert xlToRight 'insère une colonne auxiliaire
        .Columns(2) = "=RIGHT(RC[-1],4)&LEFT(RC[-1],2)" 'la formule permute les nombres
        .Sort .Columns(2), xlAscending, Header:=xlYes 'tri sur la colonne auxiliaire
        .Columns(2).Delete xlToLeft 'supprime la colonne auxiliaire
    End With
End With
End Sub
A+
 

Pièces jointes

  • Charlie copie finale actes(1).xlsm
    24.4 KB · Affichages: 5

Discussions similaires

Statistiques des forums

Discussions
314 488
Messages
2 110 132
Membres
110 679
dernier inscrit
lpierr