Compilation onglets

Résolu/Fermé
pijed Messages postés 36 Date d'inscription samedi 19 mars 2016 Statut Membre Dernière intervention 21 juin 2019 - 3 mars 2018 à 15:16
pijed Messages postés 36 Date d'inscription samedi 19 mars 2016 Statut Membre Dernière intervention 21 juin 2019 - 6 mars 2018 à 15:59
Bonjour,

je cherche à compiler les places A40:D40 des différents onglets d'un dossier. J'ai trouvé une macro qui peut m'aider. Par contre j'aimerais savoir ce que sont le H et le 7. J'ai compris que dans cette macro la compilation se fait de la colonne B à la colonne Q mais elle semble ne ramener que la ligne 1. Moi il me faut la ligne 40 de A à D.
Par ailleurs j'aimerais savoir s'il y a un moyen de ne faire que raffraîchir les données si elles se trouvent déjà 1 fois dans l'onglet compilation car lorsqu'on lance la macro ci-dessous cela rapporte de nouveau les onglets déjà compilés et on ne sait plus quoi est quoi.

Sub a()
Dim ws As Worksheet, x&
For Each ws In Worksheets
If ws.Name <> "Compilation" Then
x = ws.Cells(Rows.Count, "H").End(3).Row
ws.Range(ws.Cells(7, "B"), ws.Cells(x, "Q")).Copy
Sheets("Compilation").Cells(Rows.Count, "B").End(3)(2).PasteSpecial xlValues
Application.CutCopyMode = False
End If
Next
End Sub

Je vous remercie par avance pour votre aide précieuse.

4 réponses

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 702
4 mars 2018 à 08:08
Bonjour,

explication du code
Sub a()
    Dim ws As Worksheet, x&
    
    For Each ws In Worksheets
        If ws.Name <> "Compilation" Then
            x = ws.Cells(Rows.Count, "H").End(3).Row        'dernier cellule non vide colonne H de la feuille en cours
            ws.Range(ws.Cells(7, "B"), ws.Cells(x, "Q")).Copy   'copy les donnees de la feuille en cours de cellule B7 a Qx
            'colle les donnees copiees dans feuille Compilation a partir de la colonne B en partant de la derniere cellule non vide
            Sheets("Compilation").Cells(Rows.Count, "B").End(3)(2).PasteSpecial xlValues
            Application.CutCopyMode = False     'vide le presse papier
        End If
    Next
End Sub


Je vois pour le rafraîchissement données feuille présentes dans Compilation
0
PHILOU10120 Messages postés 6368 Date d'inscription lundi 16 avril 2012 Statut Contributeur Dernière intervention 22 avril 2024 796
4 mars 2018 à 10:51
Bonjour Pijed

Un fichier avec ce que j'ai compris de votre problème

https://www.cjoint.com/c/HCejYZ2RaIx
0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 702
4 mars 2018 à 11:14
Bonjour PHILOU10120,
Petit detail:
un moyen de ne faire que raffraîchir les données si elles se trouvent déjà 1 fois dans l'onglet compilation
Petit probleme, comment savoir quels onglets doivent figurer dans la liste Compilation

en attendant
Piged:
exemple de code qui au premier tour recupere les donnees des feuilles non "Compilation" avec en plus le nom de l'onglet pour majour suivant si deplacement feuille ou ....... et les tours suivant:
si deja dans la liste: majour des donnees (meme si ce sont les memes)
si pas dans la liste: ajoute les donnees et nom, mais comme precise plus haut, quels sont les onglets qui doivent entrer dans la feuille Compilation???????????
Sub a()
    Dim ws As Worksheet, x&
    
    For Each ws In Worksheets
        If ws.Name <> "Compilation" Then
            Sh = ws.Name
            With Worksheets("Compilation")
                drl = .Range("E" & .Rows.Count).End(xlUp).Row + 1    'dernier cellule non vide colonne H de la feuille en cours
                Nb = Application.CountIf(.Range("E2:E" & drl), Sh)      'nombre de fois nom d'onglet dans le liste
                If Nb < 1 Then            'nom d'onglet pas dans liste
                    .Range("A" & drl).Resize(, 4) = ws.Range("A40:D40").Value       'copie des donnees
                    .Range("E" & drl) = ws.Name                                                     'ecriture nom d'onglet pour recherche
                Else    'nom d'onglet dans la liste
                    L = .Columns("E").Find(Sh, .Cells(1, "E"), , xlWhole).Row          'recherche ligne nom d'onglet pour majour
                    .Range("A" & L).Resize(, 4) = ws.Range("A40:D40").Value
                End If
            End With
        End If
    Next
End Sub
0
pijed Messages postés 36 Date d'inscription samedi 19 mars 2016 Statut Membre Dernière intervention 21 juin 2019
4 mars 2018 à 19:07
Bonsoir,

Effectivement, la question des onglets à ramener est utile; Il faudrait que ce ne soit que les onglets qui contiennent "CPTES 17". car effectivement si tous mes onglets sont ramenés je me retrouve ensuite avec un travail de tri un peu ennuyeux. Je vous remercie par avance de votre aide :)
0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 702
5 mars 2018 à 07:49
Bonjour,

Je suppose que CPTES 17 est une partie du nom d'onglet:

Sub a()
    Dim ws As Worksheet, x&
    
    For Each ws In Worksheets
        If ws.Name <> "Compilation" And ws.Name Like "CPTES 17*" Then
            Sh = ws.Name
            With Worksheets("Compilation")
                drl = .Range("E" & .Rows.Count).End(xlUp).Row + 1    'dernier cellule non vide colonne H de la feuille en cours
                Nb = Application.CountIf(.Range("E2:E" & drl), Sh)      'nombre de fois nom d'onglet dans le liste
                If Nb < 1 Then            'nom d'onglet pas dans liste
                    .Range("A" & drl).Resize(, 4) = ws.Range("A40:D40").Value       'copie des donnees
                    .Range("E" & drl) = ws.Name                                                     'ecriture nom d'onglet pour recherche
                Else    'nom d'onglet dans la liste
                    L = .Columns("E").Find(Sh, .Cells(1, "E"), , xlWhole).Row          'recherche ligne nom d'onglet pour majour
                    .Range("A" & L).Resize(, 4) = ws.Range("A40:D40").Value
                End If
            End With
        End If
    Next
End Sub
0
pijed Messages postés 36 Date d'inscription samedi 19 mars 2016 Statut Membre Dernière intervention 21 juin 2019
5 mars 2018 à 16:09
Bonjour et merci beaucoup pour votre réponse. Le point est que le fait d'ajouter"CPTES 17", la macro me ramène les bons onglets mais pas les cellules A40 à D40.
La maco sans And ws.Name Like "CPTES 17*" fonctionne bien mais effectivement j'ai des onglets que je ne souhaite pas avoir. voyez-vous pourquoi?
0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 702
5 mars 2018 à 17:21
Re,
ramène les bons onglets mais pas les cellules A40 à D40
Ca marche chez moi et pas chez vous????????????, Bizarre !!!!
Pouvez mettre votre fichier a dispo

Pour transmettre un fichier,
Veillez a ce qu'il n'y ait PAS DE DONNEES CONFIDENTIELLES
il faut passer par un site de pièce jointe tel que cjoint.com

Allez sur ce site : https://www.cjoint.com/
Clic sur parcourir,
Cherche ton fichier,
clic sur ouvrir,
Clic sur "Créer le lien cjoint",
Copier le lien,
Revenir ici le coller dans une réponse...

ou
'mon partage
https://mon-partage.fr/

ou
www.transfernow.net 'fichier jusqu'a 4G
0
PHILOU10120 Messages postés 6368 Date d'inscription lundi 16 avril 2012 Statut Contributeur Dernière intervention 22 avril 2024 796
Modifié le 6 mars 2018 à 15:39
Bonjour Pijed

La macro fonctionne si on met une * avant "*CPTES 17*"




0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 702
6 mars 2018 à 15:54
Bonjour PHILOU10120,
La macro fonctionne si on met une * avant "*CPTES 17*"
oui, si nom: aCPTES 17x

mais "CPTES 17*
Si nom: CPTES 17x

Et chez moi marche tres bien avec "CPTES 17*. Mais le gars a ecrit:
les onglets qui contiennent "CPTES 17". Alors premier cas ou deuxieme??
Sur que dans tous les cas "*CPTES 17*" marche, mais tout depend de ce que l'on veut ....
0
pijed Messages postés 36 Date d'inscription samedi 19 mars 2016 Statut Membre Dernière intervention 21 juin 2019
6 mars 2018 à 15:59
Ca marche, merci à vous deux pour votre aide efficace et rapide.

Pour le raffraîchissement de la macro, je vais écraser la page "COMPILATION" et relancer la macro :). Encore merci
0