Macro pour injecter dans les onglets

[denistoulon]

Bonjour à tous,

Je fais appel à vous pour me résoudre un problème dont je ne trouve absolument pas la solution.

Dans mon fichier ci-joint il y a un onglet a attribuer : Je voudrais que dès que j'ai attribue une livraison à un chauffeur (voir exemple) la ligne disparait dans l'onglet et s'affecte dans l'onglet du chauffeur.

Est il possible d'avoir une petite macro pour transférer ?
et les lignes non affectées reste sur l'onglet a attribuer?

Merci de votre aide très précieuse.


I

 

[Jacky67]

Bonjour à tous,

Je fais appel à vous pour me résoudre un problème dont je ne trouve absolument pas la solution.

Dans mon fichier ci-joint il y a un onglet a attribuer : Je voudrais que dès que j'ai attribue une livraison à un chauffeur (voir exemple) la ligne disparait dans l'onglet et s'affecte dans l'onglet du chauffeur.

Est il possible d'avoir une petite macro pour transférer ?
et les lignes non affectées reste sur l'onglet a attribuer?

Merci de votre aide très précieuse.


I

Bonjour,

Une proposition en PJ
La transmission dans les feuilles des chauffeurs se fait à la validation du nom du chauffeur
-A condition que la feuille correspondante au nom existe.
-Que toutes les cellules de la ligne en question soient renseignées
Dans ces deux cas un message d'avertissement est diffusé

 

[denistoulon]

Bonsoir Jacky67

Merci pour ta réponse. Puis je te poser une question? ça fonctionne qu'à partir de la 2 ème ligne.
Si tu mets le nom du chauffeur en ligne 5 il ne se passe rien, c'est à partir de la 6 que cela fonctionne.
Merci, bonne soirée
Denis

 

[job75]

Bonsoir denistoulon, jacky67,

Dans le fichier joint tous les tableaux sont organisés en tableaux Excel (ListObjects).

Le transfert est réalisé par cette macro dans le code de la feuille "A attribuer" :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, d As Object, w As Worksheet, lig&, sup As Range
Set r = Intersect(Target, ListObjects(1).DataBodyRange) 'tableau Excel
If r Is Nothing Then Exit Sub
'---liste des noms des feuilles de calcul---
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For Each w In Worksheets
    d(w.Name) = ""
Next
'---transferts---
For Each r In Intersect(r.EntireRow, ListObjects(1).DataBodyRange).Rows 'si entrées multiples
    If d.exists(CStr(r.Cells(4))) Then
        If Application.CountA(r) = 9 Then 'si la ligne est complète
            With Sheets(CStr(r.Cells(4))).ListObjects(1).DataBodyRange 'tableau Excel
                lig = .Rows.Count - (.Cells(.Rows.Count, 1) <> "")
                .Cells(lig, 1) = r.Cells(1)
                .Cells(lig, 4).Resize(, 5) = r.Cells(5).Resize(, 5).Value
            End With
            Set sup = Union(IIf(sup Is Nothing, r, sup), r)
        End If
    End If
Next
Application.EnableEvents = False 'désactive les évènements
If Not sup Is Nothing Then sup.Delete xlUp
Application.EnableEvents = True 'réactive les évènements
End Sub

Le transfert a lieu quand la ligne du tableau est complète.

A+

 

[Jacky67]

Bonsoir Jacky67

Merci pour ta réponse. Puis je te poser une question? ça fonctionne qu'à partir de la 2 ème ligne.
Si tu mets le nom du chauffeur en ligne 5 il ne se passe rien, c'est à partir de la 6 que cela fonctionne.
Merci, bonne soirée
Denis

Re..
??
Je n'éprouve aucune difficulté sur le fonctionnement sur aucune des lignes dans l'exemple donné.
Il y a une plage nommée "Chauffeurs" qu'il faut reproduire dans le classeur réel.

 

[denistoulon]

Bonjour Jacky67,
oui vous avez raison ça marche mais je n'arrive pas à tout comprendre
J'ai rajouté des onglets et changé les noms des onglets mais j'ai un message d'erreur
En ligne 3 de la macro
If Intersect(Target, [Chauffeurs]) Is Nothing Then devient jaune et bug
Ou va t'il chercher chauffeurs?

Merci de votre aide qui m'est précieuse

Cordialement

 

[job75]

Bonjour à tous,

Si Jacky67 avait eu le bon goût de me saluer mon post #4 ne serait sans doute pas passé inaperçu.

L'intérêt de ma solution entre autre c'est qu'elle fonctionne quand on fait des entrées multiples.

Voyez par exemple en copiant et collant une colonne sur elle-même dans la feuille "A attribuer".

A+

 

[Jacky67]

Bonjour à tous,

Si Jacky67 avait eu le bon goût de me saluer mon post #4 ne serait sans doute pas passé inaperçu.

L'intérêt de ma solution entre autre c'est qu'elle fonctionne quand on fait des entrées multiples.

Voyez par exemple en copiant et collant une colonne sur elle-même dans la feuille "A attribuer".

A+

Désolé Job75 , d'avoir oublié ce salut.
Mais ce n'est pas par ''mauvais goût'', un simple oubli. Pardonne moi.
Mais ta proposition, n'est certainement pas passé inaperçue.

 

[Jacky67]

En ligne 3 de la macro
If Intersect(Target, [Chauffeurs]) Is Nothing Then devient jaune et bug
Ou va t'il chercher chauffeurs?

Merci de votre aide qui m'est précieuse

Cordialement

Re..
[Chauffeur] est une plage nommée
Voir Formules==>gestionnaire de noms

Cette ligne
If Intersect(Target, [Chauffeurs]) Is Nothing Then Exit Sub
Pourrait être remplacée par
If Intersect(Target, [$D$5:$D$233]) Is Nothing Then Exit Sub
Pour tester.

 

[denistoulon]

Bonjour Job75

Merci pour votre proposition mais comme c'est difficile de tout comprendre sur votre macro j'ai rencontré un problème.
Bien entendu quand j'ai modifié des champs parce qu'elle tourne comme une horloge

Voilà ce que j'ai obtenu comme problème

With Sheets(CStr(r.Cells(4))).ListObjects(1).DataBodyRange 'tableau Excel est devenu jaune

Je n'ai pas osé revenir vers vous mais si vous pouvez m'aider je suis preneur

Merci Jacky 67 de votre réponse mais je n'ai strictement rien gestion des noms

Cordialement à vous

 

[job75]

Re,

With Sheets(CStr(r.Cells(4))).ListObjects(1).DataBodyRange 'tableau Excel est devenu jaune

Rappel :

Dans le fichier joint tous les tableaux sont organisés en tableaux Excel (ListObjects).

Pour créer un tableau Excel sélectionner le tableau => menu INSERTION => Tableau.

Pour le style des tableaux j'ai choisi le 1er style en haut à gauche : aucune mise en forme.

A+

 

[denistoulon]

Merci pour votre patience
A+

 

[Jacky67]

Merci Jacky 67 de votre réponse mais je n'ai strictement rien gestion des noms

Cordialement à vous

RE..
Heu…..
Dans l'exemple joint il y a ceci

En ce qui me concerne mon code n'utilise que ''Chauffeurs"
Le reste était déjà présent, et, à mon avis peut-être supprimer.