Concaténer plsr tableaux sur une feuille à son ouverture

Bonjour à tous,

Je dois créer un outil de suivi pour mon équipe.

Les membres de mon équipe remplissent les informations dans un même tableau (avec les mêmes entrées) disposé sur des feuilles différentes (pour chaque client).

Je souhaite synchroniser les informations de ces différents tableaux sur une feuille à son ouverture.

Je suis débutant sur VBA. Un ami m'a gentillement coder la macro sur un bouton qui permet d'effectuer la concaténation des informations. Je souhaite maintenant que cette action soit effectuée à l'ouverture de la feuille (plutot que d'appuyer sur un bouton).

J'ai essayé de récuperer le code sur internet mais j'ai constamment l'erreur : "Compile error, expected end sub"

Pourriez vous me donner un petit coup de pouce s'il vous plaît ?

Merci bien

Voici le code de la macro associé à la feuille

Private Sub Worksheet_Activate() ' En activant la feuille.

    MsgBox "Bonjour !"
    Sub Datacopy()

    Dim Sh As Worksheet
    Dim Plage As Range
    Dim i As Integer
    Dim LR, LR2, LR3 As Long

    Worksheets("Dashboard").Activate
    LR3 = Range("A" & Rows.Count).End(xlUp).Row
    Range("A6", "Q" & LR3 + 1).Select
    Selection.ClearContents

   Range("A1", "O4").UnMerge

    For i = 5 To Sheets.Count
    Sheets(i).Activate

        LR = Range("B" & Rows.Count).End(xlUp).Row

        If LR > 16 Then

            Set Plage = Range("A17", "Q" & LR)

            Plage.Copy

            Worksheets("Dashboard").Activate
            LR2 = Range("A" & Rows.Count).End(xlUp).Row
            Range("A" & LR2 + 1, "Q" & LR2 + 1).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False

        End If

    Next i

    Worksheets("Dashboard").Activate
    Range("A1", "Q4").Merge
    Columns.AutoFit

End Sub
End Sub

Bonjour,

Voir champs surlignés.

Tu as un "End sub" de trop

Cdlt.

Private Sub Worksheet_Activate() ' En activant la feuille.

    MsgBox "Bonjour !"
    Sub Datacopy()

    Dim Sh As Worksheet
    Dim Plage As Range
    Dim i As Integer
    Dim LR as long, LR2 as long, LR3 As Long

    Worksheets("Dashboard").Activate
    LR3 = Range("A" & Rows.Count).End(xlUp).Row
    Range("A6", "Q" & LR3 + 1).Select
    Selection.ClearContents

   Range("A1", "O4").UnMerge

    For i = 5 To Sheets.Count
    Sheets(i).Activate

        LR = Range("B" & Rows.Count).End(xlUp).Row

        If LR > 16 Then

            Set Plage = Range("A17", "Q" & LR)

            Plage.Copy

            Worksheets("Dashboard").Activate
            LR2 = Range("A" & Rows.Count).End(xlUp).Row
            Range("A" & LR2 + 1, "Q" & LR2 + 1).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False

        End If

    Next i

    Worksheets("Dashboard").Activate
    Range("A1", "Q4").Merge
    Columns.AutoFit

End Sub
End Sub

Bonjour Jean-Eric,

Merci beaucoup pour ta réponse.

J'ai enlevé un "End Sub" et j'ai toujours le message d'erreur.

Je te joins quelques copies d'écran.

Tu m'a dit de regarder les éléments que tu as surlignés "LR as long, LR2 as long" Je ne comprends pas pourquoi tu as surligné ce bout de code. Pourrais tu m'expliquer plz ?

Merci encore

Re,

Supprime:

Sub Datacopy()

Peux-tu envoyer ton fichier?

Cdlt.

Salut Jean-Eric,

Si j'enlève Datacopy je me retrouve avec le même problème non résolu par mon ami. Le programme tourne en boucle et bug.

Je te joins mon fichier anonymisé en espérant que tu puisses y voir plus clair.

L'idée c'est d'avoir un fichier de suivi de partenariats. On a un onglet Contents ou on peut acceder à toutes les feuilles en un clic, un onglet Summary pour avoir une rapide overview des partenariats, et enfin l'onglet Dashboard qui contient les informations recompilées de toutes les feuilles suivantes. Une feuille correspond à une entreprise.

Si tu as d'autres conseils concernant l'organisation du fichier n'hésite pas.

Merci bien,

Re,

A tester

Ca marche incroyablement bien.

Merci beaucoup !

Puis je te remercier d'une quelconque manière ?

Quentin

Re,

Ta satisfaction me suffit.

A bientôt sur ce forum.

Cdlt.