Macro en VBA qui ajoute un Nom en le classant au sein d'une liste

Bonjour à tous,

Je me casse les dents sur une solution qui me permettrait dans le fichier ci joint d'avoir en Feuil2 un BOUTON dont la finalité est d'ajouter un NOM au sein d'une liste existante (Colonne A) tout en classant ce nom au bon endroit de manière alphabétique et tout en préservant les valeurs affecté aux case à cocher et les liaisons au cellule de cette dernière .

La finalité étant qu'une personne lambda sans compétence puisse ajouter un prénom classé dans le bon ordre, sans avoir à opérer des copier/coller de case à cocher, sans utiliser la fonction tri ( qui jusqu'ici chamboule mes liaisons cellules/case à cocher).

l'idée pour moi était de suivre un ordre en ce sens:

1) déclencher une fenêtre formulaire " Ajouter nouveau NOM1"

2) Copier/coller ce nouveau NOM1 en bas de la liste après avoir laissé une ligne vide

3) repérer le NOM2 existant dans la liste qui suivra de manière alphabétique ce nouveau NOM1

4)copier/coller les valeurs ( uniquement) de la plage formée verticalement par NOM2 jusque bas de la liste , et horizontalement des colonnes A à I

5)Copier/coller le NOM1 et les valeurs de sa ligne correspondante ( de A à I) à son nouvel emplacement ( c'est à dire juste avant NOM2)

6) et enfin, effacer le doublon restant du NOM1 initialement copié en bas de liste

J'imagine que mon process plutôt fastidieux n'est pas optimal et qu'il y a une manière beaucoup plus simple d'envisager la chose mais je ne trouve pas..

Et la macro ( ajouter nom sans tri) que j'essaie de bricoler en pur amateur ne conduit pas tout à fait à ce que je veux

Bonjour,

Je me casse les dents sur une solution qui me permettrait dans le fichier ci joint d'avoir en Feuil2 un BOUTON dont la finalité est d'ajouter un NOM au sein d'une liste existante (Colonne A) tout en classant ce nom au bon endroit de manière alphabétique et tout en préservant les valeurs affecté aux case à cocher et les liaisons au cellule de cette dernière .

1. Bon je dirais déjà que là, il faut éviter les case à cocher type objet sur des feuilles
On peut très bien mettre une case à cocher par click dans une cellule en utilisant la police Wingdings

Prenez le fichier exemple dans ce lien --> https://forum.excel-pratique.com/s/goto/832675
Ensuite allez sur la feuil1 et faites un double-click dans les cellules de la colonne A.

De là il est très facile dans votre projet de faire des tri.

2. Lorsque vous parlez de formulaire vous voulez dire Userform ?

Votre avis avant d'aller plus loin

Je me réponds à moi même ..j'ai résolu l'affaire :)

voici désormais le code que j'utilise:

Sub AjouterNomSansTri()
    Dim Nom1 As String
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim targetRow As Long
    Dim plage1 As Range
    Dim cible1 As Range

    ' Définir la feuille de calcul (Feuil2)
    Set ws = ThisWorkbook.Sheets("Feuil2")

    ' Demander à l'utilisateur d'entrer le nouveau nom (Nom1)
    Nom1 = InputBox("Entrez le nouveau nom (Nom1):", "Ajouter un nom")

    ' Vérifier si l'utilisateur a annulé l'entrée
    If Nom1 = "" Then Exit Sub

    ' Trouver la première cellule vide en partant du haut dans la colonne A
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    targetRow = IIf(lastRow < 2, 2, lastRow + 1)

    ' Vérifier si Nom1 existe déjà dans la plage A2:A100
    If WorksheetFunction.CountIf(ws.Range("A2:A100"), Nom1) > 0 Then
        MsgBox "Ce nom est déjà encodé.", vbExclamation, "Erreur"
        Exit Sub
    End If

    ' Définir la plage1 (A2:A100)
    Set plage1 = ws.Range("A2:A100")

    ' Trouver la cellule cible1 (NOM2 qui suit Nom1 dans l'ordre alphabétique)
    Set cible1 = FindNextName(Nom1, plage1)

    If cible1 Is Nothing Then
        ' Si aucun NOM ne suit Nom1, ajouter Nom1 à la première ligne vide de la colonne A
        ws.Cells(targetRow, 1).Value = Nom1
        MsgBox Nom1 & " a bien été encodé par ordre alphabétique dans la liste", vbInformation + vbOKOnly, "Succès"
    Else
        ' Si un NOM suit Nom1, effectuer la procédure de déplacement et collage
        CopierEtColler Nom1, cible1, ws
        MsgBox Nom1 & " a bien été encodé par ordre alphabétique dans la liste", vbInformation + vbOKOnly, "Succès"
    End If
End Sub

Function FindNextName(Nom1 As String, plage As Range) As Range
    ' Trouver la cellule cible1 (NOM2 qui suit Nom1 dans l'ordre alphabétique)
    Dim cel As Range
    For Each cel In plage
        If cel.Value > Nom1 Then
            Set FindNextName = cel
            Exit Function
        End If
    Next cel
    Set FindNextName = Nothing
End Function

Sub CopierEtColler(Nom1 As String, cible1 As Range, ws As Worksheet)
    ' Effectuer une sélection (selection1)
    Dim selection1 As Range
    Set selection1 = ws.Range("A" & cible1.Row & ":I" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)

    ' Copier dans le presse-papiers
    selection1.Copy

    ' Coller les valeurs uniquement (décalage d'une ligne vers le bas)
    ws.Cells(cible1.Row + 1, 1).PasteSpecial xlPasteValues
    Application.CutCopyMode = False

    ' Temps d'attente de 5 secondes
    Application.Wait (Now + TimeValue("0:00:05"))

    ' Effacer les valeurs correspondantes aux colonnes de A à I de la ligne contenant la cible1
    ws.Range("A" & cible1.Row & ":I" & cible1.Row).ClearContents

    ' Temps d'attente de 2 secondes
    Application.Wait (Now + TimeValue("0:00:02"))

    ' Coller la valeur de Nom1 dans la cellule cible1
    cible1.Value = Nom1
End Sub

Et on est d'accord DAN.... les cases à cocher dans Excel...c'est vraiment pas utilisable en l'état ..( problème de copier.coller, de liaison aux cellules, de lenteur et instabilité)

Mais en l'occurrence ici j'ai besoin d'un fichier manipulable par des Novices complets....et l'ajout de case à cocher rends le fichier plius intuitif

quoiqu'il en soit..cela fonctionne enfin comme je veux

Merci

waouh compliqué cela

Voyez tout de même le fichier ci-joint pour exemple et cliquez dans l'endroit où vous voyez des cases à cocher. Je n'ai pas traité l'ajout des noms

Après à vous de voir
Mais bon si terminé pensez à

Cordialement

edit :

Mais en l'occurrence ici j'ai besoin d'un fichier manipulable par des Novices complets....et l'ajout de case à cocher rends le fichier plius intuitif

Bah comme je vous l'ai proposé je ne pense pas que cela soit compliqué qui plus est j'utilise un tableau structuré
A vous de voir si je dois aller plus loin pour incorporer l'ajout de Nom.

Re edit : votre formule à placer en J2 devient ceci et sera recopiée automatiquement vers le bas --> =CONCATENER((SI($B2="R";"Lu";""));(SI($C2="R";" Ma";""));(SI($D2="R";" Me";""));(SI($E2="R";" Je";""));(SI($F2="R";" Ve";""));(SI($G2="R";" Sa";"")))

Bonjour à tous,

si tu ne connais pas tu devrais regarder fichier exemple fourni par Dan.
C'est exactement comme une case à cocher, mais par double-clic et sans les emmerdes...
eric

bonjour le fil, l'ajout des noms dans le fichier de DAN

Peut-être c'est mieux de choisir pour le double-clicque ou celui de droite au lieu du "selection"

@ BsAlv,

A quoi cela sert de poster sachant que Mathos vous écrit qu'il a sa solution (inutile d'alourdir le forum si une solution est trouvée)

Et si j'avais voulu poster via double click je l'aurais fait aussi.

Dingue tout de même

@Dan, la solution que j'avais proposé était avec des MFC fonctionnantes et en utilisant un tableau structuré, donc la "manipulation par des Novices complets" sera mieux, je crois. Si on compare les 2 macros, on parle de 2 choses différentes.

Vous voulez que je l'enlève ?

@Bsalv :

Vous voulez que je l'enlève ?

Non laissez-le. De toute façon je ne pense pas qu'il a chargé ma proposition qui était nettement plus simple que ce qu'il fait. Il est content avec sa solution. On se demanderait même pourquoi il a posté.
De mon coté je n'ai volontairement pas mis un code pour l'ajout de noms en attendant d'abord son retour sur le principe des cases à cocher que lui proposait.