Déplacer une ligne dans une autre feuille en fonction de sa valeur (un mot)

Bonjour,

Et avant tout, Bonne année.

Je suis novice en VBA. ceci pour éviter que vous me parliez comme si je pouvais comprendre

Voici mon problème : "je voudrais que des lignes se classent dans les feuilles correspondant au pseudo des participants".

Explication de mon fonctionnement actuel :

- Je gère un challenge de lecture et je récolte des informations via un formulaire en ligne que je colle dans une feuille (2) intitulée "feuille-dépot-formulaire" (nom modifiable au besoin). (je peux vous fournir le lien, si nécessaire)

- Je procède à un tri pour classer orthographiquement. Cette manipulation sera par la suite, grâce à vous, inutile.

- Ces résultats sont classés en fonction de mes besoins et de calculs simples dans la feuille 3, intitulée feuille-répartition. (liens de rappels)

- Puis, et c'est là que j'ai besoin de vous, je prends manuellement chaque ligne (colonnes C : J) pour la placer dans la feuille du bon participant, sans perte de format. (collage 123).

J'ai trouvé un sujet qui ressemble à ce que je voudrais faire : ici mais qui ne prend pas en compte la variable pseudo.

Or les feuilles sont nommées par les pseudos (fictifs dans l'exemple) et les participants entrent leurs résultats en fonction de ces pseudos (menu déroulant dans le formulaire, pour garantir l'ortho 8- Chuis une bille, mais j'ai au moins compris ça).

J'ai aussi trouvé ce code :

Sub Dispatche()
Application.ScreenUpdating = False

For i = 2 To Sheets.Count
    Sheets(i).Range("A2:F65536").ClearContents
Next i

For i = 2 To Range("A65535").End(xlUp).Row
    client = Cells(i, 3).Value
    lg = Sheets(client).Range("A65535").End(xlUp).Row + 1
    Rows(i).Copy Sheets(client).Range("A" & lg)
Next i

End Sub

qui classe en fonction de la colonne "client" mais je ne comprends suffisament son fonctionnement (novice, hein) pour l'adapter. En plus, il efface les informations déjà en place (ClearContents) mais je suppose qu'il suffirait de supprimer cette partie ?

A ce sujet, j'ai vu que vous glissiez des lignes expliquant ce que fait chaque fonction j'avoue que ça m'a permis de trouver les deux codes joints et que j’apprécierai vraiment de suivre et d'essayer de comprendre.

Bref, Help !

Voici le fichier :

Les pseudos réels contiennent des lettres (maj et min) et des chiffres, mais je peux supprimer ces derniers et uniformiser l'écriture, si cela vous simplifie la vie.

Ah, j'ai 58 participants cette année (laissé une poignée dans le doc), avec des modes de fonctionnement différents, du coup, la première "ligne" (8 colonnes) devra s’inscrire en A5 et surtout ne pas effacer les informations déjà présentes (colonnes K : M)

J'espère que les informations transmises vous suffisent, sinon, posez vos questions, je tenterai de répondre dans les plus brefs délais. Je vous remercie pour l'aide que vous pourrez m'apporter,

Bien à vous,

nanet

[edit] j'ai trouvé aussi ce sujet, est-ce que cela pourrait servir de base ? https://forum.excel-pratique.com/viewtopic.php?f=2&t=109792

Bonjour nanet

Un sujet simulaire :

https://forum.excel-pratique.com/viewtopic.php?f=2&t=117748&p=714665#p714665

klin89

Oh, merci ^^ j'ai effectué plusieurs recherches mais pas trouvé ce topic. Je tente.

Well, j'y ai cru

En tous cas, déjà, ça déplace les infos et c'est top !

Mais cela ne déplace pas celles que je veux ^^ ET, si je retente, ça m'efface les premières informations pour les remplacer au lieu de les mettre à la suite...

J''ai renommé l'onglet repartition pour que ce soit plus simple, et changé ce nom en lieu et place d'entretien comme dans le fichier d'origine (voir topic)

Voici ce que j'ai entré :

Option Explicit
Sub test()
    Dim r As Range, e, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    With Sheets("Repartition").Range("b1").CurrentRegion.Offset(1)
        For Each r In .Columns(1).Cells
            If r.Value <> "" Then
                If Not dico.exists(r.Value) Then
                    Set dico(r.Value) = r(, 4).Resize(, 7)
                Else
                    Set dico(r.Value) = Union(dico(r.Value), r(, 4).Resize(, 7))
                End If
            End If
        Next
    End With
    For Each e In dico
        If Evaluate("isref('" & e & "'!a1)") Then dico(e).Copy Sheets(e).Range("a5")
    Next
End Sub

• Où est-ce que je fais une erreur ?
• Comment faire en sorte que les informations s'accumulent ?

Merci d'avance,

nanet

re nanet

Comme ceci :

For Each e In dico
    If Evaluate("isref('" & e & "'!a1)") Then
        With Sheets(e)
            If IsEmpty(.Range("a5").Value) Then
                dico(e).Copy Sheets(e).Range("a5")
            Else
                dico(e).Copy Sheets(e).Range("a" & Rows.Count).End(xlUp)(2)
            End If
        End With
    End If
Next
Set dico = Nothing

klin89

Merci

Ça marche !

voici le code définitif, si ça peut servir à quelque'un

Option Explicit
Sub test()
    Dim r As Range, e, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    With Sheets("Repartition").Range("b1").CurrentRegion.Offset(1)
        For Each r In .Columns(1).Cells
            If r.Value <> "" Then
                If Not dico.exists(r.Value) Then
                    Set dico(r.Value) = r(, 2).Resize(, 8)
                Else
                    Set dico(r.Value) = Union(dico(r.Value), r(, 2).Resize(, 8))
                End If
            End If
        Next
    End With
    For Each e In dico
    If Evaluate("isref('" & e & "'!a1)") Then
        With Sheets(e)
            If IsEmpty(.Range("a5").Value) Then
                dico(e).Copy Sheets(e).Range("a5")
            Else
                dico(e).Copy Sheets(e).Range("a" & Rows.Count).End(xlUp)(2)
            End If
        End With
    End If
Next
Set dico = Nothing
    MsgBox "Répartition réalisée.", vbInformation, "Confirmation"
End Sub

Klin89

Bon fausse joie, cela ne marche pas sur le fichier principal, uniquement que le fichier d'essai (et encore avec des bugs) avec des valeurs fictives et des noms fictifs... mais dès que je rentre le code dans le bon fichier, rien ne se passe !

Je vous poste le document avec des informations réelles, et deux onglets renommés avec les "bons" pseudos.

Désolée ^^