XL 2016 Résumé de tableau complexe

[M@xu3L]

Bonjour à tous,

Je reviens vous voir pour faire à nouveau un résumé de tableau mais plus complexe que la dernière fois.

Ici j'ai un fichier avec plusieurs onglets et dans ces onglets différents tableau avec des dates tous le temps au même endroit (colonne A). J'ai plusieurs temps à respecter (t=0, t=6 mois, t=12 mois,ect...) et donc j'aimerai savoir quand j'arrive a la date dans un tableau résumé.

Je vous joint un exemple de fichier pour bien comprendre.

Merci d'avance

 

[job75]

Bonjour M@xu3L,

Il n'y a pas de tableau Résumé...

A+

 

[M@xu3L]

Bonjour M@xu3L,

Il n'y a pas de tableau Résumé...

A+

C'est justement ce que j'aimerai créer mais je ne sais pas comment faire... Voici a quoi cela pourrait ressembler
Sachant que dans nom il me faudrait le nom qui est présent dans les lignes plus grande ( ex: ligne 1, 11, 21, ect)

 

[job75]

Vous vous moquez du monde.

Il n'y a que vous qui pouvez savoir ce qui doit se trouver dans le tabkeau.

 

[M@xu3L]

Vous vous moquez du monde.

Il n'y a que vous qui pouvez savoir ce qui doit se trouver dans le tabkeau.

Mais je vous ai mit un exemple de tableau résumé à quoi sa devrait ressembler je comprend pas la...

 

[job75]

Pour l'instant le tableau Résumé est vide.

Quand vous l'aurez rempli complètement on pourra peut-être en trouver la logique.

 

[M@xu3L]

Pour l'instant le tableau Résumé est vide.

Quand vous l'aurez rempli complètement on pourra peut-être en trouver la logique.

Ok je comprend désolé mais je ne savait pas comment le montrer donc la j'ai rempli les tableau comme j'aimerai qu'il soit rempli automatiquement en scannant le fichier.

 

[job75]

Bonjour M@xu3L,

La macro affectée au bouton :

Sub MAJ()
Dim fichier As Variant, F As Worksheet, ligdeb&, lig&, w As Worksheet, c As Range, i&, dat
fichier = Application.GetOpenFilename("Fichier xlsx(*.xlsx),*.xlsx")
If fichier = False Then Exit Sub
Set F = Sheets("Résumé")
ligdeb = 7
lig = ligdeb + 1
Application.ScreenUpdating = False
F.Range("A" & lig & ":C" & F.Rows.Count).Delete xlUp 'RAZ
With Workbooks.Open(fichier)
    For Each w In .Worksheets
        Set c = w.Cells(1)
        While c <> ""
            F.Cells(lig, 1) = w.Name 'onglet
            F.Cells(lig, 2) = c 'nom
            For i = c.Row + 4 To c.Row + 7
                dat = w.Cells(i, 1)
                If IsDate(dat) Then If dat > Date Then F.Cells(lig, 3) = dat: Exit For
            Next i
            Set c = c(11)
            lig = lig + 1
        Wend
    Next w
    .Close False
End With
F.Range("A" & ligdeb & ":C" & lig - 1).Borders.Weight = xlThin 'bordures
End Sub

A+

 

[M@xu3L]

Bonjour M@xu3L,

La macro affectée au bouton :

Sub MAJ()
Dim fichier As Variant, F As Worksheet, ligdeb&, lig&, w As Worksheet, c As Range, i&, dat
fichier = Application.GetOpenFilename("Fichier xlsx(*.xlsx),*.xlsx")
If fichier = False Then Exit Sub
Set F = Sheets("Résumé")
ligdeb = 7
lig = ligdeb + 1
Application.ScreenUpdating = False
F.Range("A" & lig & ":C" & F.Rows.Count).Delete xlUp 'RAZ
With Workbooks.Open(fichier)
    For Each w In .Worksheets
        Set c = w.Cells(1)
        While c <> ""
            F.Cells(lig, 1) = w.Name 'onglet
            F.Cells(lig, 2) = c 'nom
            For i = c.Row + 4 To c.Row + 7
                dat = w.Cells(i, 1)
                If IsDate(dat) Then If dat > Date Then F.Cells(lig, 3) = dat: Exit For
            Next i
            Set c = c(11)
            lig = lig + 1
        Wend
    Next w
    .Close False
End With
F.Range("A" & ligdeb & ":C" & lig - 1).Borders.Weight = xlThin 'bordures
End Sub

A+

Merci beaucoup c'est exactement ce que je voulais ^^

Crdl