Microsoft 365 Faire un onglet de Récap de tous les onglets

[Fanou44]

Bonsoir la communauté !!

Un sujet sur lequel je bute depuis pas mal d'heures

J'ai X feuilles identiques nommées "Projet#1", "Projet#2", "Projet#3", etc... Je voudrais pouvoir, en cliquant sur un bouton "Mise à jour de la synthèse", récupérer des informations de ces feuilles pour les rassembler dans une feuille "Synthèse_Projets".

L'algorithme ressemblerait à ceci :

1- Vider les données déjà présentes dans le tableau de la feuille "Synthèse_Projets", en conservant les entêtes du tableau ;

2- Pour chaque feuille dont le nom contient "Projet#" :

--> Copier la cellule I10 (c'est le nom du projet) ;

--> Coller la cellule dans la colonne A de la feuille "Synthèse_Projets" intitulée "Projet" ;

--> Copier la plage G23 à R500, en ne prenant que les lignes dont la colonne G est non-vide ;

--> Coller la plage dans les colonnes B à M, en conservant la mise en forme source (largeur des colonnes, hauteur des lignes, couleurs, ...)

--> Fusionner la colonne A pour qu'elle corresponde à toutes les lignes du Projet.

Vous comprendrez mieux avec le fichier en pièce jointe.

Merci d'avance pour votre aide les génies

 

[vgendron]

Hello
un essai ici

PS: les cellules fusionnées.. c'est la plaie...

Sub Synthèse2()
Dim ws As Worksheet
Dim WsSynt As Worksheet

Set WsSynt = Sheets("Synthèse_Projets")

Application.DisplayAlerts = False
WsSynt.UsedRange.Offset(6).Delete
Application.DisplayAlerts = True
        
For Each ws In ActiveWorkbook.Sheets
    If ws.Name <> "Projet modèle" And ws.Name Like "Projet" & "*" Then
        finsynt = Application.WorksheetFunction.Max(WsSynt.Range("B" & WsSynt.Rows.Count).End(xlUp).Row + 1, 7)
        With ws
             .Range("I10").Copy Destination:=WsSynt.Range("A" & finsynt)
            fin = .Range("G" & .Rows.Count).End(xlUp).Row
            
            Set zonetocopy = .Range("G23:R" & fin)
            zonetocopy.Copy Destination:=WsSynt.Range("B" & finsynt)
'            WsSynt.Range("A" & finsynt).Resize(zonetocopy.Rows.Count - 1).Merge
        End With
    End If
Next ws
With WsSynt
    finsynt = Application.WorksheetFunction.Max(.Range("B" & .Rows.Count).End(xlUp).Row + 1, 7)
    .Range("A7:M" & finsynt).UnMerge
    .Range("F7:F" & finsynt).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
    finsynt = Application.WorksheetFunction.Max(.Range("B" & .Rows.Count).End(xlUp).Row + 1, 7)

    'remerger la colonne A
    deb = 7
    fin = 7
    i = 7
    Do
        If .Range("A" & i + 1) <> "" Or i = finsynt - 1 Then
            .Range("A" & deb & ":A" & fin).Merge
            deb = i + 1
            fin = i
        Else
            fin = i + 1
            
        End If
        i = i + 1
    Loop Until i > finsynt
    
End With
End Sub

 

[Fanou44]

Tu sais quoi ??? T'es un génie !!!!

J'ai fait des tests, et c'est vraiment TOP

3 petits points pour peaufiner :
- J'ai créé un projet#5 dans mon fichier : sur la tâche 1.2, je n'ai pas saisi la colonne K "date de début prévisionnelle". Lorsque je met à jour la synthèse, cette tâche 1.2 n'est pas récupérée. Y a-t-il un moyen de récupérer toutes les tâches, même si elles n'ont pas de date de début prévisionnel ?
- Dans la feuille de synthèse, y a-t-il moyen de refusionner les colonnes L et M ?
- Dans la feiulle de synthèse, y a-t-il moyen de mettre des bordures (traits noirs fins) pour séparer chaque projet ?

Avec tout ça, mon fichier sera parfait !
Merci mille fois pour ton aide, et pour la rapidité de ta réponse !!!!!!!!!!!!!!!!!

 

[vgendron]

Hello

une nouvel essai avec commentaires
encore une fois, la présence de cellules et lignes fusionnées complique énormément la tache..
pourquoi fusionner deux lignes pour les taches?
pourquoi fusionner 2 colonnes (L et M) ou encore C et D ?

Sub Synthèse2()
Application.ScreenUpdating = False 'désactivation du refresh d'écran pour éviter l'effet sapin de noel de l'écran et accélerer le temps de traitement
Dim ws As Worksheet
Dim WsSynt As Worksheet

Set WsSynt = Sheets("Synthèse_Projets")

Application.DisplayAlerts = False 'on désactive les messages d'alerte
WsSynt.UsedRange.Offset(6).Delete 'on efface la feuille de synthèse hors entete
Application.DisplayAlerts = True 'on réactive les messages d'alerte
        
For Each ws In ActiveWorkbook.Sheets 'pour chaque feuille du classeur
    If ws.Name <> "Projet modèle" And ws.Name Like "Projet" & "*" Then 'si on est sur une feuille projet (HORS projet modèle)
        finsynt = Application.WorksheetFunction.Max(WsSynt.Range("B" & WsSynt.Rows.Count).End(xlUp).Row + 1, 7) 'on récupère le numéro de la première ligne NON vide (fonction max pour compenser le pb de cellule fusionnée)
        With ws 'avec la feuille
             .Range("I10").Copy Destination:=WsSynt.Range("A" & finsynt) 'on copie la cellule I10
            fin = .Range("G" & .Rows.Count).End(xlUp).Row 'derniière ligne de la feuille à copier
            .Range("G23:R" & fin).Copy Destination:=WsSynt.Range("B" & finsynt) 'on copie toutes les données de la feuille (lignes vides incluses)
        End With
    End If
Next ws

' à ce stade de la macro, toutes les feuilles projets ont été importées dans la feuille de synthèse
With WsSynt 'dans la feuille synthèse
    finsynt = Application.WorksheetFunction.Max(.Range("B" & .Rows.Count).End(xlUp).Row + 1, 7) 'première ligne vide de la feuille sur la colonne B
    .Range("A7:M" & finsynt).UnMerge 'on supprime toutes les cellules fusionnées
    'suppression des lignes vides==> il faut avoir UNE colonne qui contiennet OBLIGATOIREMENT une donnée lorsque la ligne est à garder et AUCUNE donnée lorsqu'il faut la supprimer
    .Range("G7:G" & finsynt).SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'suppose que la date de fin est TOUJOURS remplie
    
    finsynt = Application.WorksheetFunction.Max(.Range("B" & .Rows.Count).End(xlUp).Row + 1, 7) 'première ligne vide sur la colonne B

    'remerger la colonne A
    deb = 7
    fin = 7
    i = 7
    Do
        If .Range("B" & i) = "." Then .Range("C" & i).Resize(1, 2).Merge
        .Range("L" & i).Resize(1, 2).Merge
        If .Range("A" & i + 1) <> "" Or i = finsynt - 1 Then
            .Range("A" & deb & ":A" & fin).Merge
            deb = i + 1
            fin = i
        Else
            fin = i + 1
            
        End If
        i = i + 1
    Loop Until i > finsynt
    
    'un peu de mise en fore
    Set zone = .Range("A7:M" & finsynt - 1)
    
    With zone
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
    End With
End With
Application.ScreenUpdating = True
End Sub

 

[vgendron]

je me suis permis de simplifier tes macros d'insertion
pour copier une ou des lignes pas besoin de
1) selectionner les lignes
2) copier la selection
3) selectionner la ligne destination
4)coller

ca se fait en UNE ligne
Ligneàcopier.copy destination:=LigneDestination

dans le cas d'un pastespecial.. il faut passer par les 4 étapes.. et ca.. je n'ai jamais compris pourquoi..

 

[Fanou44]

Hello !
De retour de vacances aujourd'hui, je découvre ton super job !

Peux-tu m'expliquer pourquoi tu as choisi la colonne G "date de fin prévue" pour supprimer les lignes vides ? Ne peut-on pas prendre une autre colonne afin que toutes les lignes apparaissent dans la synthèse, même si elles sont incomplètes ?

Merci encore, c'est très instructif !