XL 2016 Résumé de tableau complexe

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

M@xu3L

XLDnaute Junior
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
 

Pièces jointes

Solution
Bonjour M@xu3L,

La macro affectée au bouton :
VB:
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...
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.
 

Pièces jointes

Bonjour M@xu3L,

La macro affectée au bouton :
VB:
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+
 

Pièces jointes

Bonjour M@xu3L,

La macro affectée au bouton :
VB:
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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 tableau d'alerte
Réponses
2
Affichages
102
Réponses
2
Affichages
247
Réponses
4
Affichages
144
Réponses
7
Affichages
180
Réponses
0
Affichages
128
Réponses
24
Affichages
447
Réponses
5
Affichages
253
Réponses
10
Affichages
175
Réponses
4
Affichages
126
Retour