Déplacer des lignes en VBA

Bonjour Michel,

Je suis en train de revoir mon classeur pour passer, non plus de quatre valeurs à rechercher mais à sept. Je pense que j'y suis arrivé après mettre penché sur les variables tableaux.
Mais j'ai une question concernant les caractère accentués utilisés dans le nom des onglets et dans les variables recherchées : Peut-on les utiliser sans problème?
En effet les données de la feuille palmarès sont extrait d'une base de données Access et il y a des caractères accentués.
Je pose la question car il est impératif que le nom des onglets et des variables recherchés soit identique.

Merci d'avance pour ta réponse.
Cordialement.Mistral

Bonjour

Valeur1, 2, 3.... données par quoi: cellules, userform.... ?
type de valeur: string, integer...... ?

au besoin

Mettre le classeur sans données confidentielles en pièce jointe sur https://www.cjoint.com/
et coller le raccourci  proposé (clic droit) dans le message de réponse 

Dans l’attente

Bonjour Michel,

Merci pour ta réponse.
La colonne C sera recalculée.
Avec cette formule j'extraie le premier mot d'une colonne:
=GAUCHE(D3;TROUVE(" ";D3)-1)

que je copie par un Copier/Coller de la valeur dans la colonne C et c'est sur cette valeur que je souhaite déplacer mes lignes.

Je ne peux pas, aujourd'hui, préparer un fichier anonyme pour le mettre sur ci-joint.

Cordialement.
Mistral

Bonjour Michel,

Je viens de créer un classeur test que tu pourras télécharger avec ce lien:

https://www.cjoint.com/c/ELyk4eCqFqy

Il convient donc de couper le ligne de la ligne de la valeur de la colonne C et de la coller en dernière position de la feuille portant le même nom que la cellule de la colonne C.

Cordialement
Mistarl

code pour le principe

tu te débrouilleras pour les valeurs 1 à 4
l'emplacement des 5 tableaux sur les feuilles, etc

option Explicit
Dim T_in
'-------------------------
Sub dispatcher()
Dim Derlig As Byte, valeur As String, Cptr As Byte, Nbre As Byte
    Application.ScreenUpdating = False
    With Sheets(1)
        Derlig = .Columns("A").Find(what:="*", searchdirection:=xlPrevious).Row
        T_in = .Range("A1:I" & Derlig)
         For Cptr = 1 To 4
            valeur = Choose(Cptr, "valeur1", "valeur2", "valeur3", "valeur4")
            Nbre = Application.CountIf(.Columns("C"), valeur)
            selectionner valeur, Nbre, Cptr
        Next
        .Range("A1:I" & Derlig).Clear
    End With
End Sub
'-----------------------------------------------
Sub selectionner(choix, Nbrv, onglet)
Dim T_out, Cptv As Byte, Col As Byte, Lig As Byte
    ReDim T_out(1 To Nbrv, 1 To 9)
    For Cptv = 1 To UBound(T_in)
        If T_in(Cptv, 3) = choix Then
                Lig = Lig + 1
                For Col = 1 To 9
                    T_out(Lig, Col) = T_in(Cptv, Col)
                Next
        End If
    Next
        With Sheets(onglet + 1)
            .Range("A1").Resize(Nbrv, 9) = T_out
        End With
End Sub

la maquette de W
http://www.cjoint.com/c/ELylcXyGioZ

 Michel

Re,

Je viens de tester ce que tu m'as envoyé sur ton fichier et cela fonctionne.
Par contre quand j'essaye la même macro sur mon fichier test je plante :

Erreur d'exécution 9
L'indice n'appartient pas à la sélection.

Cette erreur se produit à cet endroit:
Sub selectionner(choix, Nbrv, onglet)
Dim T_out, Cptv As Byte, Col As Byte, Lig As Byte
ReDim T_out(1 To Nbrv, 1 To 9)
For Cptv = 1 To UBound(T_in)
If T_in(Cptv, 3) = choix Then
Lig = Lig + 1
For Col = 1 To 9
T_out(Lig, Col) = T_in(Cptv, Col)
Next
End If
Next
With Sheets(onglet + 1)
.Range("A1").Resize(Nbrv, 9) = T_out
End With
End Sub

Je ne comprends pas pourquoi.

oui mais comme tu ne peux pas m'envoyer le fichier...

Bonjour Michel,

Hier à 11h59 j'ai posté une réponse avec un lien mais visiblement tu n'as pas vu mon message dans lequel je te donnais un lien pour télécharger un fichier test. Je te le redonne :

https://www.cjoint.com/c/ELyk4eCqFqy

J'espère que ce malentendu ne mettra pas fin à ton aide.
Cordialement.
Mistral

bonjour,

Comme quoi, quand on demande le classeur, c'est pour éviter que un ou des bénévoles travaillent au moins 2 fois pour la m^me procédure. Merci de t'en souvenir.

http://www.cjoint.com/data3/ELAiZqWfijR_retourccm-EC-Test.xlsm

 Michel

Bonjour Michel,

Merci à toi et je prends bonne note de ta remarque. Je serais plus vigilent à l'avenir.

Je viens de tester ton classeur et cela fonctionne presque correctement. La répartition des lignes, par catégorie, est correcte mais les lignes ne sont pas effacées de la feuille d’origine. Je pense que cela vient du fait que dans la dernière version la ligne :

.Range("A1:I" & Derlig).Clear

n’y est plus.

D’autre part ce matin j’ai essayé d’adapter ta première macro. J’avais bien modifié les quatre valeurs recherchées mais j’avais une erreur 9 suite à une modification du nombre de colonne à copier dans la macro : Sélectionner.

Je pense que cela vient du fait que le nombre de colonne était différent entre T_in et T_Out. J’ai constaté cela dans la fenêtre espion où je visualisais ces deux variables. Peux-tu éclairer ma lanterne ?
Comment sont déclarées ces deux exprésions, et plus particulièrement T_In?

D’avance merci.
Cordialement.
Mistral

.Range("A1:I" & Derlig).Clear

Effectivement, car dans mes essais, je n'avais pas intérêt à l'effacer (re télécharger le classeur)
mais écris plutôt:
.Range("A2:I" & Derlig).Clear

si le dernier marche maintenant, pour l'ancien je ne l'ai plus en t^te, donc...

Je suppose que tu recommande A2 plutôt que A1 pour conserver la ligne de titre.

Par contre tu ne me réponds pas pour T_In et T_Out pourtant j'aurais souhaité que tu le fasses pour me permettre de comprendre comme tu faisais.
Mais si tu n'as pas le temps ce n'est pas grave.

Ton dernier fichier me permet d'avancer dans la création de mon classeur.

Cordialement
Mistral

Bonjour
peux être comme ça
a oui modifier le nom de onglet mettre "Diplôme" a la place de "Diplome"

Sub Deplace()
Sheets("Palmares").Select
Nlig = Cells(Rows.Count, 1).End(xlUp).Row
   For L = 2 To Nlig
      Onglet = Range("C" & L).Value
      Rows(L).Cut
      Lig = Sheets(Onglet).Cells(Rows.Count, 1).End(xlUp).Row + 1
      Sheets(Onglet).Rows(Lig).Insert
   Next
End Sub

e
A+
Maurice