XL 2016 Récupération des données de plusieurs onglets en un seul

[bnolwalid]

Bonjour tout le monde,

j'aurais besoin de votre aide SVP.
J'ai un fichier Excel qui contient plusieurs onglets et qui évolue chaque semaine. chaque onglet est nommé de la manière suivante : Odj jj/mm/aaaa (la date du jour de la semaine x) et à l'intérieur c'est exactement la même structure, c'est à dire des données dans les colonnes de A à i et un nombre de lignes différents.

Le but est de la macro qui m'intéresse doit :

- récupérer toutes les données de chaque onglet l'un après l'autres et de les synthétiser dans nouvel onglet "Synthèse"
- récupérer la date de chaque onglet et la copier dans une colonne dans la feuille Synthèse en plus des données de l'onglet.

Je ne sais si j'étais clair mais n'hésitez pas SVP à me demander plus de détails.
Votre aide serait la bienvenue.

Crdlt

 

[job75]

Bonjour bnolwalid,

Pas clair du tout mais tel que c'est parti j'hésite à demander quoi que ce soit.

A+

 

[bnolwalid]

Bonjour Job 75,
Merci de ton retour.
Peut être avec un fichier exemple ça sera plus simple (enfin j'espère) :

- contenu du fichier Excel lusieurs onglets (Odj jj_mm_aa exp 14_05_19)

Le but est de récupérer le contenu de chaque onglet et tout synthétiser dans un seul nouvel onglet "Synthèse" (un simple copier/coller du contenu).
Lors de cette récupération, j'aimerais aussi récupérer le nom de l'onglet sous forme de date en créant une colonne Date dans l'onglet synthèse (voir exemple).
PI, le fichier évolue chaque semaine mais la structure des onglets est la même.
Si toujours pas clair, n'hésites pas stp.
Merci

 

[job75]

Voyez le fichier joint et cette macro dans le code de la feuille "Synthèse" (clic droit sur l'onglet et Visualiser le code) :

Private Sub Worksheet_Activate()
Dim ncol%, lig&, w As Worksheet, x$
ncol = 9 'modifiable
lig = 2 '1ère ligne de destination
Application.ScreenUpdating = False
Rows("2:" & Rows.Count).Delete 'RAZ
For Each w In Worksheets
    x = Replace(Right(w.Name, 8), "_", "/")
    If IsDate(x) Then
        With w.Rows("3:" & w.Cells(w.Rows.Count, 1).End(xlUp).Row)
            If .Row > 2 Then
                .Copy Cells(lig, 1)
                Cells(lig, ncol + 1).Resize(.Rows.Count) = CDate(x)
                lig = lig + .Rows.Count + 1
            End If
        End With
    End If
Next
End Sub

La macro se déclenche quand on active la feuille.

 

[bnolwalid]

Bonjour Job 75,
Désolé pour le tutoiement, je vous ai pris pour un collègue.
Chapeau !
Votre macro répond exactement à mon besoin, j'espère que ça ne vous a pas pris beaucoup de temps.

Merci beaucoup pour votre aide précieuse.

Bonne journée à vous

 

[job75]

Désolé pour le tutoiement, je vous ai pris pour un collègue.

Le tutoiement ne me dérange absolument pas, ni le terme "collègue", mais je préfère "ami".

 

[bnolwalid]

Merci cher ami