Macro pour injecter dans les onglets

denistoulon

XLDnaute Junior
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
 

Fichiers joints

Jacky67

XLDnaute Accro
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é
 

Fichiers joints

Dernière édition:

denistoulon

XLDnaute Junior
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

XLDnaute Barbatruc
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" :
Code:
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+
 

Fichiers joints

Jacky67

XLDnaute Accro
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

XLDnaute Junior
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

XLDnaute Barbatruc
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

XLDnaute Accro
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.:confused:
Mais ta proposition, n'est certainement pas passé inaperçue.
 

Jacky67

XLDnaute Accro
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

XLDnaute Junior
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

XLDnaute Barbatruc
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+
 

Jacky67

XLDnaute Accro
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
upload_2018-12-6_17-23-11.png
En ce qui me concerne mon code n'utilise que ''Chauffeurs"
Le reste était déjà présent, et, à mon avis peut-être supprimer.
 

Discussions similaires


Haut Bas