Regrouper plusieurs tableaux sur une seule feuille - VBA

Le 14/03/2023 à 11:35

Bonjour à tous!

19test-vba.xlsx (203.13 Ko)

J'ai besoin de votre aide sur VBA que je ne maitrise pas du tout

Sur mon fichier, j'ai un onglet par mois et je souhaite regrouper ces informations sur une seule feuille Récap qui doit se mettre à jour dès que que je modifie un élément sur les différents onglets.

J'ai essayé d'appliquer le code ci-dessous que j'avais trouvé sur ce site, et il répond à moitié à ma problématique. Les infos basculent bien sur l'onglet récap, mais l'ordre chronologique n'est pas respecté (Par mois et par semaine/date), et certaines de mes formules ne marchent plus (Celles qui figurent sur la colonne A pour la date):

Sub RegroupeFeuilles() 'dans "Récap" Dim Lg&, Sh As Worksheet, f As Worksheet Set f = Sheets("Récap") f.Range("a2:p" & f.[a65000].End(xlUp).Row).ClearContents 'efface Récap For Each Sh In Worksheets If Sh.Name <> f.Name And Sh.Name <> "bibi" Then 'feuilles à ne pas traiter Lg = Sh.Range("a" & Rows.Count).End(xlUp).Row Sh.Range("a3:p" & Lg).Copy Destination:= _ f.Range("a" & Rows.Count).End(xlUp)(2) End If Next End Sub

Je vous joins un exemple de mon fichier.

Je vous remercie pour votre aide!!

edit Dan : codes avec balises

Sub RegroupeFeuilles() 'dans "Récap" 
Dim Lg&, Sh As Worksheet, f As Worksheet 
Set f = Sheets("Récap") f.Range("a2:p" & f.[a65000].End(xlUp).Row).ClearContents 'efface Récap 
For Each Sh In Worksheets 
If Sh.Name <> f.Name And Sh.Name <> "bibi" Then 'feuilles à ne pas traiter 
Lg = Sh.Range("a" & Rows.Count).End(xlUp).Row 
Sh.Range("a3:p" & Lg).Copy Destination:= _
 f.Range("a" & Rows.Count).End(xlUp)(2) 
End If Next 
End Sub
Le 14/03/2023 à 13:15

Bonjour,

Merci de bien vouloir utiliser les balises de codes en cliquant sur le bouton </> et en collant vos codes dans la fenêtre.
Et dans votre cas ici, mettre tout sans retour à la ligne c'est encore moins clair à lire.

Pour votre demande, le plus simple est de faire un copier valeur de vos tableaux. Possible cela ?
Pour la mise à jour, on peut ré-exécuter le code en cliquant sur la feuille Recap si vous voulez.

Rem : Il faudrait que la feuille Janvier commence aussi en colonne B comme pour les feuilles des mois suivants. Dans votre fichier elle commence en colonne A . Du coup, cela décale vos tableaux

Dites moi

Cordialement

Le 14/03/2023 à 14:06

Bonjour,

Ah oui désolée, je ne savais pas qu'il y avait l'option pour les balises.

J'espère que cela est plus clair:

Sub RegroupeFeuilles() 'dans "Récap"
Dim Lg&, Sh As Worksheet, f As Worksheet
        Set f = Sheets("Récap")
    f.Range("a2:p" & f.[a65000].End(xlUp).Row).ClearContents    'efface Récap

    For Each Sh In Worksheets
        If Sh.Name <> f.Name And Sh.Name <> "bibi" Then         'feuilles à ne pas traiter
            Lg = Sh.Range("a" & Rows.Count).End(xlUp).Row
            Sh.Range("a3:p" & Lg).Copy Destination:= _
            f.Range("a" & Rows.Count).End(xlUp)(2)
        End If
    Next
End Sub

Les onglets par mois sont amenés à changer au quotidien c'est pour cela que je cherche à automatiser l'onglet récap (De janvier jusqu'à décembre 2023). Cela m'évitera d'aller copier/coller au quotidien mes modifications sur l'onglet récap, et voir même qu'il y ait des oublis pour le mettre à jour.

Oui en effet il y a un décalage entre l'onglet janvier et le reste des onglets. Je vous joins le fichier modifié.

Merci pour votre aide!

11test-vba.xlsx (202.89 Ko)
Le 14/03/2023 à 14:19

Cela m'évitera d'aller copier/coller au quotidien mes modifications sur l'onglet récap, et voir même qu'il y ait des oublis pour le mettre à jour.

C'est le but du code que je vous ai préparé si vous êtes d'accord sur la proposition que je vous ai suggérée concernant la mise à jour. Quid ?

Le 14/03/2023 à 16:27

Rebonjour,

Si j'ai bien compris, la mise à jour dont vous me parlez c'est celle que vous avez directement indiqué sur mon premier commentaire?

Si c'est le cas, je l'avais déjà testé et il ne marche pas entièrement

Je vous laisse ci-joint le résultat obtenu une fois que j'ai exécuté le code ci-dessous:

Sub RegroupeFeuilles() 'dans "Récap"
Dim Lg&, Sh As Worksheet, f As Worksheet
        Set f = Sheets("Récap")
    f.Range("a1:p" & f.[a65000].End(xlUp).Row).ClearContents    'efface Récap

    For Each Sh In Worksheets
        If Sh.Name <> f.Name And Sh.Name <> "bibi" Then         'feuilles à ne pas traiter
            Lg = Sh.Range("a" & Rows.Count).End(xlUp).Row
            Sh.Range("a1:p" & Lg).Copy Destination:= _
            f.Range("a" & Rows.Count).End(xlUp)(2)
        End If
    Next
End Sub
18test-vba.zip (303.69 Ko)

J'ai les problèmes suivants sur mon fichier:

1 - Le mois de janvier ne remonte pas

2 - Les formules utilisées sur chaque onglet ne marchent pas une fois regroupées sur l'onglet récap.

Merci pour votre aide!

Le 14/03/2023 à 18:22

Merci de ne pas repostez votre fichier. J'ai votre premier qui ne sert de travail sans quoi je dois chaque fois recommencer. Puis on évite d'alourdir le forum inutilement.

Là je vous ai posé une question à deux reprises et à laquelle vous ne répondez pas.... J'ai besoin de votre avis sur ce point

Le 15/03/2023 à 08:36
"Pour votre demande, le plus simple est de faire un copier valeur de vos tableaux. Possible cela ?"

Si c'est de cette question que vous me parler, non, mon but est justement d'automatiser cette partie là étant donné que j'ai des onglets qui vont jusqu'à décembre + mettre à jour l'onglet récap dès que je modifie une information sur les onglets mensuels.

Je ne sais pas si ma réponse est clair?

Merci.
Le 15/03/2023 à 09:17

"Pour votre demande, le plus simple est de faire un copier valeur de vos tableaux. Possible cela ?"

Si c'est de cette question que vous me parler, non, mon but est justement d'automatiser cette partie là étant donné que j'ai des onglets qui vont jusqu'à décembre + mettre à jour l'onglet récap dès que je modifie une information sur les onglets mensuels.

Je ne pense pas que vous avez compris la proposition. En deuxième ligne, je vous ai aussi écrit ceci : Pour la mise à jour, on peut ré-exécuter le code en cliquant sur la feuille Recap si vous voulez.

La proposition suppose donc que la feuille recap est juste un résumé des mois à visualiser et non à modifier. Les modifications sont toujours effectuées dans les feuilles mois et la sélection de l'onglet Recap met toujours à jour cette feuille

Le 15/03/2023 à 10:09

Oui tout à fait c'est exactement ça que je cherche! L'onglet récap est juste un résumé, et toutes les modifications se font directement sur l'onglet par mois. L'onglet Récap devra se mettre à jour automatiquement à chaque modification des onglets mensuels.

Merci.. et désolée de vous embêter avec cela

Le 15/03/2023 à 10:28

Merci.. et désolé de vous embêter avec cela

Pas de souci.

Faites ceci :

1. remplacez votre code dans le module par celui ci-dessous :

Option Explicit
Public stpevt As Boolean
Sub RegroupeFeuilles()
Dim Lg As Integer, lgrecap As Integer
Dim Sh As Worksheet, f As Worksheet

Application.ScreenUpdating = False
stpevt = True
Set f = Sheets("Récap")
f.UsedRange.Delete
For Each Sh In Worksheets
    If Sh.Name <> f.Name And Sh.Name <> "bibi" Then
        Lg = Sh.UsedRange.Rows.Count
        lgrecap = f.UsedRange.Rows.Count + 1
        Sh.Range("a3:p" & Lg).Copy
        With f.Range("a" & lgrecap)
            .PasteSpecial Paste:=xlPasteValues
            .PasteSpecial Paste:=xlPasteFormats
        End With
    End If
Next Sh
Application.ScreenUpdating = True
stpevt = False
End Sub

2. Code RECAP
- Faites un click droite sur l'onglet RECAP
- choisir l'option "Visualiser le code"
- collez le code ci-dessous dans la fenêtre

Private Sub Worksheet_Activate()
If stpevt = True Then Exit Sub
Call RegroupeFeuilles
End Sub

A chaque fois que vous aller sélectionner l'onglet RECAP, la feuille sera mise à jour.

Pour que cela fonctionne bien, je vous conseille d'abord de sélectionner une centaine de lignes en dessous de la dernière ligne contenant le v + 1 ligne (exemple dans JANVIER les lignes 381 à 500, puis clik droite et Supprimer). Cela parce que le résultat met des lignes vides dans votre feuille Récap. Vous avez certainement ajouté quelque chose dans ces lignes de votre vrai fichier.

NB : attention dans votre fichier j'ai aussi remarqué que des données (S1, S2.....) sont placées vers les lignes 1750 et plus bas. Je ne vois pas d'où cela peut venir

Dites moi

Si ok et terminé ->

Cordialement

Le 15/03/2023 à 14:32

C'est parfait!!! Cela a bien fonctionné!!

J'ai regardé pour les lignes S1, S2 cela provient d'une feuille masqué que je vais supprimer.

J'avais une dernière question et je vous embête plus. Sur l'onglet Récap, entre chaque mois il n'y a pas le même nombre de lignes qui séparent les mois.

Comment je pourrais rajouter cette instruction disant par exemple entre les mois il faut qu'il y ait exactement 10 lignes vide?

Merci encore une fois pour votre aide, c'est exactement ce que je cherchais comme résultat

Le 15/03/2023 à 14:45

J'ai regardé pour les lignes S1, S2 cela provient d'une feuille masqué que je vais supprimer.

Ah OK. Je n'avais pas été vérifier....

Sur l'onglet Récap, entre chaque mois il n'y a pas le même nombre de lignes qui séparent les mois.

En principe vous devriez avoir 1 ligne entre chaque mois. C'est pour cela que je vous ai écrit qu'il faudrait supprimer les lignes qui sont juste après 2 lignes en dessous du V. (2 lignes à cause de votre formule où se trouvent les V et qui contrôle une info deux lignes plus bas)
Des fois excel conserve des choses que l'on ne voit pas malgré que vous les avez supprimées.

Comment je pourrais rajouter cette instruction disant par exemple entre chaque mois il faut qu'il y ait exactement 10 lignes vide?

Il vous suffit de changer le 1 par 10 dans la ligne de code --> lgrecap = f.UsedRange.Rows.Count + 1 --> lgrecap = f.UsedRange.Rows.Count + 10

Si souci dites moi.

Si tout ok, pensez à cloturer le fil

Cordialement

Edit : désolé ce n'est pas correct ce que je vous ai proposé ci-dessus. Faites ceci :

Dans le code remplacez

lgrecap = f.Range("A1").CurrentRegion.Rows.Count + 1

par ceci

With f.UsedRange.Rows
    If .Count = 1 Then
        lgrecap = .Count + 1
    Else: lgrecap = .Count + 10
    End If
End With
Le 15/03/2023 à 15:12

C'est réglé! Merciiii énormément pour votre aide

Rechercher des sujets similaires à "regrouper tableaux seule feuille vba"