Classer les élèves pour l'année prochaine avec un compteur de place restant

Bonjour la team,

Merci d'avance pour votre aide :)

J'ai essayé de faire pleins de test mais c'est pas concluant j'ai commencé par des formules mais c'était trop compliqué avec les différentes conditions je cherche à faire donc un code VBA que j'ai commencé mais pas poussé

Sub CopierDonnees()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim LastRow As Long
Dim i As Long

' feuilles de travail
Set ws1 = ThisWorkbook.Sheets("Classe_auj")
Set ws2 = ThisWorkbook.Sheets("Classe_Futur")

' Trouver la dernière ligne avec des données dans Feuille1
LastRow = ws1.Cells(ws1.Rows.Count, "D").End(xlUp).Row

' Boucler à travers les lignes de Feuille1
For i = 2 To LastRow ' Commence à la ligne 2 si la première ligne contient des en-têtes
If ws1.Cells(i, "D").Value = "Passe" Then
' Copier les valeurs des colonnes A, B et C dans Feuille2
ws1.Cells(i, "A").Resize(, 3).Copy ws2.Cells(ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row + 1, "A")
End If
Next i
End Sub

**********Voilà mon besoin :

dans la feuille "Classe_auj" si dans colonne F contient le mot "Passe"

alors copier la colonne de "A" à "E"

Si dans la colonne "C" contient le mot maternelle et dans la colonne "D" contient le mot "Samedi" et dans la Colonne "E" contient le mot "matin"
alors coller dans la feuille "Ma_S_Ma"

Si dans la colonne "C" contient le mot maternelle et dans la colonne "D" contient le mot "Samedi" et dans la Colonne "E" contient le mot "midi"
alors coller dans la feuille "Ma_S_Mi"

Si dans la colonne "C" contient le mot CP et dans la colonne "D" contient le mot "Samedi" et dans la Colonne "E" contient le mot "matin"
alors coller dans la feuille "CP_S_Ma"

Si dans la colonne "C" contient le mot CP et dans la colonne "D" contient le mot "Samedi" et dans la Colonne "E" contient le mot "midi"
alors coller dans la feuille "CP_S_Mi"

Si dans la colonne "C" contient le mot Niveau 1 et dans la colonne "D" contient le mot "Samedi" et dans la Colonne "E" contient le mot "matin"
alors coller dans la feuille "N1_S_Ma"

Si dans la colonne "C" contient le mot Niveau 1 et dans la colonne "D" contient le mot "Samedi" et dans la Colonne "E" contient le mot "midi"
alors coller dans la feuille "N1_S_Mi"

etc..... Le but est que si l'élève est par exemple en niveau 1 cette année et qu'il passe alors on bascule son nom.... au Niveau 2 l'année prochaine pour le même jour même horaire

PS : j'ai une petite particularité aussi c'est que chaque classe doit compter maximum 20 élèves. J'aimerai dans la feuille "Tableau de bord" ajouter un compteur de place restant plus y a de ligne dans les feuilles (inscrits) moins il y a de place

image
image
image

bonjour,

aide-nous à t'aider. Mets un classeur exemple représentatif de ce que tu as et de ce que tu veux avoir. Par exemple celui dont tu as extrait les copies d'écran.

Bonjour h2so4,

Merci pour le retour, effectivement je viens de le mettre à jour le voici

10classe.xlsm (108.60 Ko)

bonjour,

une proposition

Sub CopierDonnees()
    ' feuilles de travail
    Set ws1 = ThisWorkbook.Sheets("Classe_auj")
    With ws1
        ' Trouver la dernière ligne avec des données dans Feuille1
        LastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
        ' Boucler à travers les lignes de Feuille1
        For i = 2 To LastRow  ' Commence à la ligne 2 si la première ligne contient des en-têtes
            If .Cells(i, "F").Value = "Passe" Then
                feuille = Left(.Cells(i, "C"), 2) & "_" & Left(.Cells(i, "D"), 1) & "_" & Left(.Cells(i, "E"), 2)
                Set ws2 = Sheets(feuille)
                ws2.Activate
                dlws2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1
                .Cells(i, 1).Resize(1, 5).Copy ws2.Cells(dlws2, 1)
            End If
        Next i
    End With
End Sub

Sub majcompteur()
    With Sheets("Tableau de Bord")
        For jour = 3 To 18 Step 5
            journee = Split(.Cells(jour, 1), " ")
            For niveau = 1 To 8
                            feuille = Left(Replace(.Cells(jour + 1, niveau), "iveau ", ""), 2) & "_" & Left(journee(0), 1) & "_" & Left(journee(1), 2)
              On Error Resume Next 'gère l'absence de certaines feuilles
                .Cells(jour + 2, niveau) = Sheets(feuille).Cells(Rows.Count, 1).End(xlUp).Row - 2
                On Error GoTo 0
            Next niveau
        Next jour
    End With
End Sub

il n'y a pas de contrôle d'erreur... tu dois faire attention à la cohérence des données (exemple tu écris Passe avec et sans espace à la fin, la macro teste Passe sans espace, ...), même chose pour "Tableau de bord", il faut éviter les espaces inutiles.

12classe.xlsm (114.51 Ko)

Merci à toi.

J'ai fait le test essayé de faire quelque modif mais ça fonctionne pas

1/ Il ne prend pas en compte toutes les lignes

image

2/ Pour ma compréhension peux-tu m'expliquer comment dans ton code il arrive a déterminer dans quelle feuille les données doivent être inscrit vue que les noms des feuilles ne sont pas préciser dans le code ? Merci bcp :)

3/ Du coups les compteurs égalements nne fonctionne pas (aussi j'aurai plus besoin d'un décompte vu que les classes max sont de 20 élèves du coups p partir de 20 est descendre à 0 pour chaque ligne renseigné

bonsoir,

Il ne prend pas en compte toutes les lignes

As-tu tenu compte de ma remarque ? Pour qu'une ligne soit sélectionnée elle doit contenir "Passe" et pas "Passe " par exemple. Pour tester j'ai dû faire ces modifications pour avoir le bon résultat. Le code fonctionne chez moi, c'est donc lié à ton fichier, tes données que je n'ai pas...

Pour ma compréhension peux-tu m'expliquer comment dans ton code il arrive à déterminer dans quelle feuille les données doivent être inscrit vue que les noms des feuilles ne sont pas précisés dans le code ? Merci bcp :)

la macro génère le nom de la feuille sur base des infos trouvées dans la feuille "classe_auj", en prenant les 2 premiers caractères de la classe, le premier caractère du jour et les 2 premiers caractères de l'heure et en les assemblant avec "_" comme caractère intermédiaire. Une logique similaire est utilisée pour le décompte.

voici une adaptation du code pour le décompte (à partir de 20)

Sub majcompteur()
    With Sheets("Tableau de Bord")
        For jour = 3 To 18 Step 5
            journee = Split(.Cells(jour, 1), " ") 'on découpe la cellule jour en jour(0) et heure(1)
            For niveau = 1 To 8 'on parcourt les classes
                .Cells(jour + 2, niveau) = 20 'par défaut 20 places disponibles
                feuille = Left(Replace(.Cells(jour + 1, niveau), "iveau ", ""), 2) & "_" & Left(journee(0), 1) & "_" & Left(journee(1), 2) 'on détermine le nom de la feuille sur base du nom de la classe
                On Error Resume Next 'gère l'absence de certaines feuilles
                .Cells(jour + 2, niveau) = 20 - (Sheets(feuille).Cells(Rows.Count, 1).End(xlUp).Row - 2) 'nombre de places disponibles
                On Error GoTo 0
            Next niveau
        Next jour
    End With
End Sub

Bonjour,

Yes, j'ai bien pris en compte le "Passe" j'ai bien fait attention aux espaces et j'ai toujours le même problème les autres élèves ne se rajoute pas (je met mon fichier en PJ)

et là il bloque à ce niveau

image

Pour le compteur merciiii beaucoup c'est excellent c'est bien ce que je recherche.

Merci pour ton explication je comprend mieux cette ligne du coup ::::: feuille = Left(.Cells(i, "C"), 2) & "_" & Left(.Cells(i, "D"), 1) & "_" & Left(.Cells(i, "E"), 2)

8classe.xlsm (162.51 Ko)

bonjour,

comme indiqué dans mon message précédent je n'ai pas fait de contrôle d'erreur. Vérifie si tu as bien tous les onglets possibles. Ici l'erreur vient du fait qu'il ne trouve pas l'onglet dans lequel mettre un élève. (Ma_D_Mi)

Bonjour,

Grrrrrrrr, je comprend pas j'ai tous les onglets et à chaque fois que j'ai une feuille en erreur au début c'était (Ma_D_Mi) après (N3_D_Mi)....... je vois pas du tout où se trouve l'erreur. J'ai bien fait attention au espace mais toujours rien. Même le filtre classique ne fonctionne pas correctement dans l'ongler "Classe_auj"

8classe.xlsm (131.33 Ko)

bonsoir,

J'ai ajouté un message d'erreur sommaire. Tu verras qu'il y a encore des espaces intempestifs.

10classe.xlsm (138.70 Ko)

Pour que ton filtre fonctionne sur ton tableau, il faut définir le tableau correctement (y inclure toutes les lignes et pas seulement les 68 premières)

Bonjour,

Un grand merciiiii à toi effectivement il y avait un espace sur le nommage d'une feuille. Encore merciiiii :)

une petite question pour comprendre/apprendre. Pourquoi sur cette ligne de commande de tu as mis " iveau "

feuille = Left(Replace(.Cells(jour + 1, niveau), "iveau ", ""), 2) & "_" &

bonjour,

dans ton tableau de bord tu as Niveau 1, Niveau 2, etc ... et les feuilles correspondantes se nomment N1_ ..., N2_..., Il faut donc enlever "iveau" pour obtenir le nom de la feuille sur base du nom de la classe trouvé dans ton tableau de bord. C'eut été beaucoup plus simple à gérer s'il y avait l'utilisation d'une même dénomination pour une même classe. (nom de feuille, tableau de bord, code niveau utilisé dans la feuille Classe_auj)

Merciiiiii beaucoup pour tes explications :)

Re-bonjour :)

Petite question stp j'ai fait une petite modification sur le fichier j'ai rajouter 2 colonnes (Colonne C et Colonne E)

du coup j'ai besoin que pour les autre feuilles il me copie que la colonne A et B & E, F et G

dans ton code que j'essaie toujours de comprendre :) j'ai modifié quelque ligne mais j'ai des bug sur l'entête je sais pas pourquoi et je n'arrive pas à lui de me copier/coller uniquement les colonne A et B & E, F et G du coup j'ai lui ai dit de me prendre .Cells(i, 1).Resize(1, 7).Copy ws2.Cells(dlws2, 1) les 7 colonnes puis j'ai rajouter un code pour supprimer les 2 que je veux pas garder (colonne C et D) ce qui marche bien mais je sais pas pourquoi parfois ça bug (comme les entêtes qui disparaissent)

5classev9.xlsm (159.60 Ko)

' Avant Modiffication

LastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
If .Cells(i, "F").Value = "Passe" Then
feuille = Left(.Cells(i, "C"), 2) & "_" & Left(.Cells(i, "D"), 1) & "_" & Left(.Cells(i, "E"), 2)
.Cells(i, 1).Resize(1, 5).Copy ws2.Cells(dlws2, 1)

Après Modification

LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row If .Cells(i, "D").Value = "Passe" Then feuille = Left(.Cells(i, "E"), 2) & "_" & Left(.Cells(i, "F"), 1) & "_" & Left(.Cells(i, "G"), 2)
.Cells(i, 1).Resize(1, 7).Copy ws2.Cells(dlws2, 1)

bonsoir,

code adapté,

Sub CopierDonnees()

    'Réduire le temps d'exécution
    Application.ScreenUpdating = False '

    Dim StartTime As Double
    Dim SecondsElapsed As Double

    'Remember time when macro starts
    StartTime = Timer

    oldStatusBar = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
    Application.StatusBar = "Traitement en cours veuillez patienter svp..."

    Dim ws As Worksheet
    Dim i As Integer

    ' Boucle à travers toutes les feuilles du classeur
    Set ws1 = ThisWorkbook.Sheets("Classe_auj")
    For Each ws In ThisWorkbook.Sheets

       ' Vérifie si la feuille n'est pas tableau_de_bord ni Classe_auj
        Select Case ws.Name
            Case "Tableau de Bord", "Classe_auj"
            Case Else
                ws1.Range("A1").Resize(1, 7).Copy ws.Range("A1") 'copie entête
                ws.Range("A2:H1000").Clear
        End Select
    Next ws
    '**********************************************************

    ' feuilles de travail
    Set ws1 = ThisWorkbook.Sheets("Classe_auj")
    With ws1
        ' Trouver la dernière ligne avec des données dans Feuille1
        LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
        ' Boucler à travers les lignes de Feuille1
        For i = 2 To LastRow  ' Commence à la ligne 2 si la première ligne contient des en-têtes
            If .Cells(i, "D").Value = "Passe" Then
                feuille = Left(.Cells(i, "E"), 2) & "_" & Left(.Cells(i, "F"), 1) & "_" & Left(.Cells(i, "G"), 2)

                On Error Resume Next
                Set ws2 = Sheets(feuille)
                If Err <> 0 Then MsgBox "feuille " & feuille & " non trouvée"
                On Error GoTo 0

                dlws2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1
                .Cells(i, 1).Resize(1, 7).Copy ws2.Cells(dlws2, 1)
            End If
        Next

        ' Boucle à travers toutes les feuilles
        For Each ws In Worksheets
            ' Vérifie si la feuille n'est pas tableau_de_bord ni Classe_auj
            Select Case ws.Name
                Case "Tableau de Bord", "Classe_auj"
                Case Else
                    ' Supprime les colonnes C et D
                    ws.Columns("C:D").Delete
            End Select
        Next ws

    End With

    Application.StatusBar = False
    Application.DisplayStatusBar = oldStatusBar

    Call majcompteur

    'Determine how many seconds code took to run
    SecondsElapsed = Round(Timer - StartTime, 2)

    'Notify user in seconds
    MsgBox "Mise à jour des classes avec succès - Temps de traitement " & SecondsElapsed & " seconds", vbInformation

    'Fin Réduction d'exécution
    Application.ScreenUpdating = True

End Sub
Rechercher des sujets similaires à "classer eleves annee prochaine compteur place restant"