Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

Staple1600

XLDnaute Barbatruc
Bonsoir @chaelie2015
Un premier essai
Code:
Sub test()
Dim f As Worksheet
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
Sheets("Finale").Columns("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
End Sub
Il reste le tri à faire
 

chaelie2015

XLDnaute Accro
Bonsoir JM
Merci pour la réponse, comme premier test ça fonctionne , mais il reste l'ordre .
ci joint le fichier.
a+
 

Pièces jointes

  • Charlie copie finale actes V1.xlsm
    19.2 KB · Affichages: 0

Staple1600

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

Bonjour,
Hello JM
Il n'y a pas de "3T 2022" dans l'exemple donné
Une autre version, mise à jour à la sélection de la feuille "finale"
Code à placer dans la feuille "finale"
VB:
Private Sub Worksheet_Activate()
    Dim Sh As Worksheet, Derlg&
    Range("a2:a" & Rows.Count).Clear
         For Each Sh In Sheets(Array("BP", "RP", "DGD", "RD"))
               Sh.UsedRange.Offset(1).Copy Cells(Rows.Count, 1).End(3)(2)
        Next
        Columns("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
       [a1].Sort Columns(1), xlAscending, Header:=xlYes
End Sub
 

Pièces jointes

  • Charlie copie finale actes.xlsm
    27.5 KB · Affichages: 5
Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonsoir @Jacky67

Net, concis.
J'achète ! (comme dirait le gars de la télé)


NB: T'es sûr que le tri fonctionne bien tel quel ?
(C'est pour cela que j'étais passé en mode "bouzin" )

PS: Il y avait un 3T 2022 dans le fichier exemple du message#1
Feuille RP, cellule C5
 

Jacky67

XLDnaute Barbatruc
PS: Il y avait un 3T 2022 dans le fichier exemple du message#1
Feuille RP, cellule C5
RE..,
Ah, je n'avais pas vu qu'il avait filtrer
Alors dans mon code il faudra déboulonner avec un "ShowAllData"
Quant au tri, l'origine du code est de Job75 que j'ai dans ma boite à idées et je ne me permets pas d'en douter
Je trouve d'ailleurs que sur les nouvelles versions, le tri est une usine à gaz
 

Pièces jointes

  • Charlie copie finale actes.xlsm
    27.6 KB · Affichages: 7
Dernière édition:

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…