XL 2016 Macro insérer/supprimer des lignes dans plusieurs feuilles

[J&J99]

Bonjour,

Je suis nouveau sur le forum et je débute dans la création de macro. J'aimerais créer un fichier récapitulatif pour les évaluations d'une classe.

Enfin d'être le plus clair possible, je m'appuie sur un document que j'ai trouvé dans ce forum "Tchock V4". Le document que je souhaiterais modifier est "Evaluation cycle 3 - 6°CHAMtest3"

J'aimerais comme dans le document "Tchock V4" réussir à insérer ou supprimer des nouveaux noms (NOM Prénom d'élève dans mon cas) dans un fichier de base (feuille "classe" dans mon classeur). Il faudrait que la nouvelle ligne créée ou supprimée le soit dans toutes les feuilles du classeur en respectant l'incrémentation des formules.

J'ai essayé de trouver le code de la macro dans la feuille "base salaries" de "Tchock V4" pour la reproduire dans mon document mais je n'ai pas réussi.

Merci beaucoup pour votre aide, je bloque depuis plusieurs jours.

Jo

 

[J&J99]

Personne...

 

[Staple1600]

Bonjour le fil, le forum

@J&J99 [Bienvenue sur le forum]
Désolé mais j'aime pas

Sinon pour ta question, ne pas oublier
1) que nous sommes en week-end
et
2) Extrait de la charte du forum

2 – Tous les membres du forum répondent gracieusement aux questions. Il n’y a donc aucune obligation de résultat et de délai.

 

[J&J99]

Bonjour,

Moi non plus je n'aime pas...
J'ai juste vu beaucoup de questions auxquelles on répondait et m'inquiétais un peu. Comme je l'ai précisé, je suis nouveau sur le forum et bien que j'avais lu la charte, je ne maîtrise pas tous les usages. En plus, je ne savais pas que le week-end n'était pas propice aux réponses. Désolé.

Bon week-end

Cordialement,

Jo

 

[Staple1600]

Re

@J&J99
Le week-end en toute logique, les occupations familiales priment
Et le week-end, c'est le temps de loisirs aussi.

Ce week-end on a entre autres choix:
Festival Cine TELERAMA
EURO de Handball
Le tennis.
etc...

Je voulaiss donc juste te prévenir que le week-end la fréquentation du forum est moindre.

 

[job75]

Bonjour J&J99, JM, le forum,

Voyez le fichier joint et cette macro dans le code de la feuille "Classe" :

Private Sub CommandButton1_Click() 'bouton Mise à jour des feuilles
Dim d As Object, i&, a, w As Worksheet, col As Variant, b() As Variant, j%
'---liste des noms-prénoms (sans doublon)---
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
With ListObjects(1).DataBodyRange
    .Sort .Columns(2), xlAscending, Header:=xlYes 'tri sur les noms-prénoms
    For i = 1 To .Rows.Count
        If .Cells(i, 2) <> "" Then d(.Cells(i, 2).Value) = d.Count 'numérotation (commence à 0)
    Next i
End With
If d.Count Then a = d.keys
'---traitement des feuilles---
For Each w In Worksheets
    If w.Name <> Me.Name Then
        If w.ListObjects.Count Then
            With w.ListObjects(1).DataBodyRange
                col = Application.Match("*Nom*Prénom*", .Rows(-1), 0)
                If IsNumeric(col) Then
                    '---repérage des noms-prénoms listés et suppression des autres---
                    If d.Count Then ReDim b(d.Count - 1) 'tableau base 0 vide
                    For i = .Rows.Count To 1 Step -1
                        If d.exists(.Cells(i, col).Value) Then
                            b(d(.Cells(i, col).Value)) = 1
                        Else
                            If i > 1 Then
                                .Rows(i).Delete xlUp
                            Else 'traitement particulier de la 1ère ligne
                                For j = 1 To .Columns.Count
                                    If Not .Cells(1, j).HasFormula Then .Cells(1, j) = "" 'efface les constantes
                                Next j
                            End If
                        End If
                    Next i
                    '---ajout des noms-prénoms manquants dans les cellules vides---
                    If d.Count Then
                        For i = 0 To UBound(a)
                            If IsEmpty(b(i)) Then .Columns(col).EntireColumn.Find("", .Cells(0, col), xlValues) = a(i)
                        Next i
                    End If
                    '---tri sur les noms-prénoms---
                    .Sort .Columns(col), xlAscending, Header:=xlYes
                End If
            End With
        End If
    End If
Next w
End Sub

Quelques explications :

1) Chaque tableau est organisé en tableau Excel, c'est un outil très puissant qu'il faut absolument connaître.

Chaque tableau se redimensionne automatiquement et les formules se recopient toutes seules.

Si on n'utilisait pas ces tableaux ici la macro serait beaucoup plus compliquée.

2) On peut ne pas afficher les boutons des filtres ou même masquer la ligne des en-têtes de colonnes (en bleu foncé).

On peut modifier le style des tableaux et les formater comme on veut ou ajouter des MFC.

3) Dans la feuille "Bilan annuel" vous aviez mis des formules de liaison avec les autres feuilles qui n'allaient pas.

Il faut pour ces liaisons utiliser impérativement la fonction DECALER, comme je l'ai fait.

A+

 

[job75]

Re,

Une variante meilleure car elle permet de se passer du bouton, placer dans ThisWorkbook :

Private Sub Workbook_SheetActivate(ByVal Sh As Object) 'se lance quand on active une feuille quelconque
Dim F As Worksheet, d As Object, i&, a, w As Worksheet, col As Variant, b() As Variant, j%
Set F = Feuil1 'CodeName de la feuille "Classe", adapter si nécessaire
Application.ScreenUpdating = False
'---liste des noms-prénoms (sans doublon)---
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
With F.ListObjects(1).DataBodyRange
    .Sort .Columns(2), xlAscending, Header:=xlYes 'tri sur les noms-prénoms
    For i = 1 To .Rows.Count
        If .Cells(i, 2) <> "" Then d(.Cells(i, 2).Value) = d.Count 'numérotation (commence à 0)
    Next i
End With
If d.Count Then a = d.keys
'---traitement des feuilles---
For Each w In Worksheets
    If w.Name <> F.Name Then
        If w.ListObjects.Count Then
            With w.ListObjects(1).DataBodyRange
                col = Application.Match("*Nom*Prénom*", .Rows(-1), 0)
                If IsNumeric(col) Then
                    '---repérage des noms-prénoms listés et suppression des autres---
                    If d.Count Then ReDim b(d.Count - 1) 'tableau base 0 vide
                    For i = .Rows.Count To 1 Step -1
                        If d.exists(.Cells(i, col).Value) Then
                            b(d(.Cells(i, col).Value)) = 1
                        Else
                            If i > 1 Then
                                .Rows(i).Delete xlUp
                            Else 'traitement particulier de la 1ère ligne
                                For j = 1 To .Columns.Count
                                    If Not .Cells(1, j).HasFormula Then .Cells(1, j) = "" 'efface les constantes
                                Next j
                            End If
                        End If
                    Next i
                    '---ajout des noms-prénoms manquants dans les cellules vides---
                    If d.Count Then
                        For i = 0 To UBound(a)
                            If IsEmpty(b(i)) Then .Columns(col).EntireColumn.Find("", .Cells(0, col), xlValues) = a(i)
                        Next i
                    End If
                    '---tri sur les noms-prénoms---
                    .Sort .Columns(col), xlAscending, Header:=xlYes
                End If
            End With
        End If
    End If
Next w
End Sub

C'est quasiment la même macro, elle se lance quand on active une feuille quelconque.

Fichier (2).

A+

 

[job75]

Re,

Je viens de corriger mes formules dans les fichiers (1) et (2).

En effet en B8 de la feuille "Classe" j'avais écrit =LIGNES(B$7:B7)

alors qu'il faut impérativement écrire =LIGNE()-LIGNE(B$7)

Pareil pour les autres feuilles et dans les formules de liaison de la feuille "Bilan annuel".

A+

 

[J&J99]

Bonjour job75 ou devrais-je dire "Dieu" ! Bonjour le forum,

C'est énorme !!! C'est exactement ce qu'il me fallait. Je regarde plus en détails dès que je peux mais ça a l'air parfait.

Merci beaucoup pour cette aide très précieuse! J'aurais été incapable de sortir un code pareil !

Jo

 

[job75]

Bonjour j&j99, le forum,

S'il y a des doublons en feuille "Classe" les macros précédentes plantent, c'est normal et salutaire...

Mais bien sûr on peut les supprimer dès le début avec ce code pour le fichier (2 bis) :

With F.ListObjects(1).DataBodyRange
    .Sort .Columns(2), xlAscending, Header:=xlYes 'tri sur les noms-prénoms
    For i = .Rows.Count To 2 Step -1
        If .Cells(i, 2) = "" Then .Rows(i).Delete xlUp Else Exit For 'supprime les cellules vides
    Next i
    For i = i To 1 Step -1
        If d.exists(CStr(.Cells(i, 2))) Then
            .Rows(i).Delete xlUp 'supprime les doublons
        Else
            d(CStr(.Cells(i, 2))) = d.Count 'numérotation (commence à 0)
        End If
    Next i
End With

Edit : j'ai aussi modifié le code plus bas en introduisant la variable rc.

A+

 

[J&J99]

Bonjour job75, le forum,

Encore merci pour ton aide et tes nombreuses améliorations.

J'ai essayé de copier-coller une des feuilles pour me permettre d'ajouter d'autres activités mais je n'ai pas pu. Sais-tu pourquoi ?
Le copier-coller me permettrait notamment d'utiliser ce travail avec des classes d'autres niveaux (qui pratiquent des activités différentes).

Merci beaucoup,

Cordialement

Jo

 

[job75]

Re,

Le copier-coller d'une feuille vers une autre se fait sans problème avec les fichiers (1) et (1 bis).

Par contre il ne peut pas se faire avec les fichiers (2) et (2 bis) parce qu'alors la macro se déclenche.

Il suffit de neutraliser provisoirement la macro en insérant End :

Private Sub Workbook_SheetActivate(ByVal Sh As Object): End

Mais pour copier toute une feuille c'est simple : clic droit sur l'onglet => Déplacer ou copier...

A+

 

[J&J99]

Bonsoir job75, le forum,

Parfait la technique du "Déplacer ou copier" pour contourner le problème du copier-coller de feuilles avec les fichiers (2) et (2 bis) !

Pourriez-vous m'indiquer votre manipulation pour figer le haut de la feuille et du tableau sans que les premières lignes apparaissent deux fois ? Lorsque je veux "enlever le fractionner" puis y revenir, je n'arrive pas à retrouver votre configuration. Je joins une capture d'écran pour que ce soit plus clair.

Dernière question. Pour plus de lisibilité, si je supprime ou déplace les lignes au dessus des tableaux, faut-il changer des formules ou la macro ?

Encore merci beaucoup pour votre aide. Je trouve ça vraiment généreux de votre part !

PS: n'étant pas un habitué des forums, dois-je maintenant rajouter [résolu] dans le titre ?

Cordialement,

Jo

 

[job75]

Bonsoir J&J99,

Après avoir fractionné la feuille il faut placer aux bons endroits les lignes de séparation : complètement à gauche pour la ligne verticale. Ensuite figez les volets.

On peut insérer ou supprimer des lignes au-dessus des tableaux, il n'y aura rien à modifier dans les formules ou la macro.

Il est inutile d'indiquer RESOLU ça ne sert strictement à rien.

Bonne fin de soiré.

 

[J&J99]

Bonjour job75, le forum,

Un "bug" est apparu dans la macro. En voulant supprimer la liste d'élèves ("Z , ZZ , ZZZ" etc.), lorsque j'ai appuyé sur "Mise à jour des feuilles", un message d'erreur est apparu. Il est relatif à " .Rows(i).Delete xlUp".
Pour info, l'ajout et la suppression de la liste d'élèves ("Z , ZZ , ZZZ" etc.) a pour but de vérifier régulièrement que les mises en formes conditionnelles et les formules fonctionnent correctement.

J'ai l'impression que l'erreur est apparue quand j'ai créé la nouvelle feuille "Basket-ball - N1".

Merci pour votre aide.

Cordialement,

Jo