Résumé des données dans un onglet à partir d'un onglet modèle

Bonjour,

Les macros n'étant pas dans mon domaine de compétence, je fais appel à des personnes qui maîtrisent.

J'ai mis mon fichier en PJ et j'ai précisé ce que j'espérai avoir en rendu final.

Pour faire simple (et aller à l'essentiel) j'aurai besoin de retransmettre dans un onglet PAC (Plan d'actions), des lignes présentes dans d'autres onglets fonction de la réponse à chaque question si elle est "NON" ou "NE SAIT PAS".
Je vous remercie par avance du temps que vous passerez à lire et/ou à me proposer une ou des solution(s).

J'en ai profité pour "demander" d'autres choses afin d'avoir un fichier excel le plus exhaustif, propre et présentable.

Merci beaucoup.

Freddy

Bonjour,

un essai (un peu de mise en forme à revoir peut-être)

Sub PAC()
Dim f As Worksheet, suffixe As String, source As Worksheet
    n = 0
    For Each f In Worksheets
        If f.Name Like "PAC*" Then
            suffixe = Mid(f.Name, 4, Len(f.Name))
            n = Application.Max(n, Val(suffixe))
        End If
    Next
    Set f = Sheets.Add(After:=Sheets(Sheets.Count))
    With f
        .Name = "PAC" & n + 1
        Sheets("PAC").Cells.Copy Destination:=.Range("A1")
        .Range("H3") = Now
    End With
    lig = f.Cells(Rows.Count, "D").End(xlUp).Row + 1
    For Each source In Worksheets
        With source
            If .Name = "Incendie" Or .Name = "Route" Then
                For i = 10 To .Cells(Rows.Count, 4).End(xlUp).Row
                    If .Cells(i, 6) = "NON" Or .Cells(i, 6) = "NE SAIT PAS" Then
                        f.Cells(lig, 4) = .Name
                        .Range("E" & i & ":H" & i).Copy Destination:=f.Cells(lig, 5)
                        lig = lig + 1
                    End If
                Next
            End If
        End With
    Next
End Sub

Holà, je n'avais pas encore lu tout ton message grisé qui était tronqué ! je vais compléter ce soir ...

Bonjour Steelson,

Je te remercie déjà pour ton aide et celle à venir, c'est déjà super.

En regardant la macro, je devine ce que j'aurai à faire en rajoutant d'autres onglets identiques à Incendie et Route.
Mais je me demandais s'il existait une écriture dans la macro qui dirait tous les onglets situés entre "incendie" et "route" alors réaliser ce qui est demandé du style :

• If .Name = "Incendie" Between .Name = "Route"

Merci de ton retour et de celui des autres.

Freddy

Freddy85 a écrit :

En regardant la macro, je devine ce que j'aurai à faire en rajoutant d'autres onglets identiques à Incendie et Route.

Mais je me demandais s'il existait une écriture dans la macro qui dirait tous les onglets situés entre "incendie" et "route" alors réaliser ce qui est demandé du style :

• If .Name = "Incendie" Between .Name = "Route"

On va trouver ce qu'il faut en effet sans citer chaque onglet. Je vais reprendre cela ce soir ...

Bonjour,

je vais reprendre

ce que je fais pour les onglets, c'est que ceux qui sont concernés (ou l'inverse ceux qui ne sont pas concernés) ont des noms qui commencent pas un espace souligné.

Sub PAC()
Dim f As Worksheet, suffixe As String, source As Worksheet
    n = 0
    For Each f In Worksheets
        If f.Name Like "PAC*" Then
            suffixe = Mid(f.Name, 4, Len(f.Name))
            n = Application.Max(n, Val(suffixe))
        End If
    Next
    Set f = Sheets.Add(After:=Sheets(Sheets.Count))
    With f
        .Select
        .Name = "PAC" & n + 1
        Sheets("PAC").Cells.Copy Destination:=.Range("A1")
        .Range("H3") = Now
    End With
    lig = f.Cells(Rows.Count, "D").End(xlUp).Row + 1
    For Each source In Worksheets
        With source
            If Left(.Name, 1) <> "_" Or .Name = "PAC" Then
                For i = 10 To .Cells(Rows.Count, 4).End(xlUp).Row
                    If .Cells(i, 6) = "NON" Or .Cells(i, 6) = "NE SAIT PAS" Then
                        .Range("D" & i & ":H" & i).Copy Destination:=f.Cells(lig, 4)
                        f.Cells(lig, 4) = .Name & "-" & f.Cells(lig, 4)
                        lig = lig + 1
                    End If
                Next
            End If
        End With
    Next
    ActiveWindow.Zoom = 70
    f.PageSetup.PrintArea = "$D2:$M" & lig - 1
    f.Range("I6:M" & lig - 1).Locked = False
    f.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

Bonjour Steelson,

Merci beaucoup pour ton aide... cela correspond à mes attentes.

Il n'y a que la question de la mise en page pour l'impression pour les nouveaux onglets qui n'est pas automatique mais ce n'était qu'un plus (une option) dans ma demande.

Vraiment et réellement MERCI

Freddy

Freddy85 a écrit :

Il n'y a que la question de la mise en page pour l'impression pour les nouveaux onglets qui n'est pas automatique mais ce n'était qu'un plus (une option) dans ma demande.

J'ai défini la zone d'impression, pour la mise en largeur etc... tu peux faire une macro "par apprentissage"

Nota : la protection est sans mot de passe. Si tu en mets un, il faudra aussi protéger la macro pour ne pas voir le mdp !

Bonjour à tous, Bonjour Steelson,

En testant la solution proposée samedi avec plus d'onglets et d'informations complétés, j'ai un bug.

En effet, depuis la macro (bouton situé sur l'onglet "PAC"), il doit y avoir une création d'un onglet PAC1, PAC2 (si PAC 1 existe, ....).
Sauf qu'à la création de PAC1, j'ai bien un résumé de toutes les réponses "NON" ou "NE SAIT PAS" des onglets incendie, route, route (2) et route (3) mais il me rajoute également des lignes PAC1 - incendie-8, ... (voir onglet PAC1, ligne 51). Ces dernières lignes sont donc en doublons des lignes du dessus.

Merci de votre aide car à la fin de la construction de ce fichier, je devrais avoir environ 10 à 15 onglets (identique Incendie et Route) qui me serviront de base à une évaluation.

Merci de vos réponses et bonne journée.

Freddy

Ah ben oui, je suis c*n ...

            If Left(.Name, 1) <> "_" And Left(.Name, 3) <> "PAC" Then

Merci Steelson !

Les oublis sont toujours possibles, l'important est de trouver la solution.

Bonne journée.