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
Trier par date Trier par votes

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
 
Vote positif 0 Vote négatif

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
Vote positif 0 Vote négatif

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
 
Vote positif 0 Vote négatif
Solution

Jacky67

XLDnaute Barbatruc
chaelie2015 à dit:
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)>​

Cliquez pour agrandir...
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:
Vote positif 0 Vote négatif

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
 
Vote positif 0 Vote négatif

Jacky67

XLDnaute Barbatruc
Staple1600 à dit:
PS: Il y avait un 3T 2022 dans le fichier exemple du message#1
Feuille RP, cellule C5
Cliquez pour agrandir...
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:
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

  • Résolu(e)
XL 2013 (RESOLU) Double clic cellule afficher/Masquer des lignes
Réponses
2
Affichages
451
chaelie2015
Z
  • Résolu(e)
Microsoft 365 Récupérer les éléments d'une liste en fonction de leur position
Réponses
2
Affichages
347
Zarnir
Z
A
  • Question
XL 2016 Calculer un pourcentage selon les choix dans des listes déroulantes
Réponses
3
Affichages
326
amgue
A
Z
  • Question
XL 2016 RECHERCHEV et double liste de choix
Réponses
2
Affichages
405
zendb
Z
  • Résolu(e)
XL 2013 (RESOLU) Copier Colonne vers ligne
Réponses
6
Affichages
194
chaelie2015
B
  • Résolu(e)
XL 2013 Comment inversé l'ordre d'enregistrement des lignes dans un tableau
Réponses
6
Affichages
250
bedley
B
  • Résolu(e)
Microsoft 365 Créer une base de données à partir de 2 onglets
Réponses
3
Affichages
322
WTF
  • Résolu(e)
XL 2013 (RESOLU) Automatisation Copie Lignes Feuilles selon leurs nom
Réponses
10
Affichages
356
chaelie2015
N
  • Question
Autres listes
Réponses
7
Affichages
510
nicolaspoulain77
N
M
  • Question
XL 2021 Rechercher dans une matrice le texte d'une cellule et copier les 10 lignes situées en dessous de ce texte retrouvé
Réponses
2
Affichages
210
JHA
J
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…