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.
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.
A ce sujet, j'ai vu que vous glissiez des lignes expliquant ce que fait chaque fonction
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
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 ^^