XL 2016 Modification d'une macro

[john.deuf]

Bonjour et meilleurs vœux a tous.

Début décembre j'ai fais appel a vous pour la création d'une macro qui a été réalisé avec succès sauf que aujourd’hui j'aimerais y faire quelques modifications.
J'aimerais que la colonne F passe en A, c'est la que le nom des onglets apparait mais si je la change moi la macro ne fonctionne plus.
En suite transférer les lignes de la feuille base a la feuille choisie avec le menu déroulant de B à O,
et encore une chose, si je fais une erreur de famille dans la feuille base j'aimerais que la correction se fasse juste en changeant de famille et non pas en effaçant et en recommençant.

Voila
il faut savoir que la macro existante a été crée par M12 qui a fait du bon boulot mais je n'arrive pas a le joindre c'est pourquoi j'ai créé une nouvelle discussion.

Merci d'avance

 

[bbb38]

Bonjour john.deuf, le forum,
Sauf erreur de ma part, je n’ai pas trouvé de macros dans le fichier joint. J’ai certainement un problème de vue… Je dois consulter…
Je suis fainéant, je n’ai pas cherché l’ancienne discussion. Il est trop tard, et mes petits yeux se ferment.
Cordialement,
Bernard

 

[Dudu2]

Bonjour,
Il y a du code en feuille "Base". Mais je ne comprends pas ce qu'il fait. Aucun commentaire explicatif donc passer du temps à décortiquer les instructions. C'est quoi la fonctionnalité initiale ?

En suite transférer les lignes de la feuille base a la feuille choisie avec le menu déroulant de B à O,

Quel menu déroulant ? Je ne vois aucun menu.
De plus les titres des colonnes des différentes feuilles ne sont pas cohérents. Donc copier la feuille "Base" de B à O dans des feuilles dont les titres diffèrent de A à D n'a pas de sens.
Et cette double ligne de titre pour certaines colonnes mais pas toutes. Pourquoi ne pas appeler la colonne "Prix d'achat HT" et "Prix d'achat KG HT" pour rester cohérent avec 1 seule ligne de titre ?

 

[john.deuf]

Bonjour,
désolé je pense que je me suis mal exprimé.
Colonne A c'est une liste déroulante pardon.
Effectivement toute les feuilles ne sont pas encore toutes mise en page sachant que je peux en rajouter a ma guise elles serons prise en compte.

 

[soan]

Bonjour john.deuf, Bernard, Dudu2,

bonne année2021, et meilleurs vœux !

je peux commander une omelette ? avec des champignons ?
et pour le dessert, ce sera une omelette norvégienne.

j'ai fait plein d'modifs, alors tu vas avoir du pain sur la planche !
mais comme t'as l'habitude du pétrin, j'me fais pas d'souci !

---

* j'ai supprimé tes 2 colonnes D et E car en D1, il y a "Produit" :
c'est donc un doublon par rapport à la colonne B "Produit".

* tout a été décalé à gauche de 2 colonnes ; ton ancienne
colonne F est passée en D, puis je l'ai mise en A.

---

* j'ai amélioré la présentation des 2 premières lignes d'en-têtes

* la ligne 3 était vide, ce qui est inutile et à éviter ; j'ai tout remonté
d'une ligne ➯ ton 1er produit est en ligne 3 et plus en ligne 4.

---

bonne nouvelle : toutes tes marges brutes ont été réduites !

je t'entends hurler d'ici : « quoi ??? !!! » ; eh oui, en tant que professionnel,
tu récupères la TVA sur tes clients car TVA à décaisser = TVA collectée / Ventes moins
TVA déductible / Achats ➯ ta marge brute n'est pas Prix vente TTC - Prix d'achat HT ;
c'est : Prix vente HT - Prix d'achat HT ; et bien sûr, ça diminue le Taux de marge ; bon,
j'te laisse le temps d'te remettre, en espérant qu'tu m'aies pas fait une syncope !

---

Noms définis

* j'en ai créé un nouveau : « Coef » : =1,055

* j'ai modifié « Feuille » : =DECALER(Base!$A$3;;;NBVAL(Base!$A:$A)-1)

---

Formules

en G3 : =SI(J3="";"";ARRONDI(J3/Coef;2))

en H3 : =SI(K3="";"";ARRONDI(K3/Coef;2))

en i3 : =SI(E3="";"";ARRONDI(E3*Coef;2))

en L3 : =SI(OU(G3="";E3="");"";ARRONDI(G3-E3;2))

en M3 : =SI(ET(J3>0;L3>0);ARRONDI(L3/J3;4);"")

j'ai déjà tiré toutes les formules jusqu'en ligne 30.

---

fais des essais pour vérifier que la colonne A se met à jour correctement.

fais des essais avec tes listes déroulantes pour vérifier qu'un produit est
dispatché sur la bonne feuille ; si tu supprimes la famille, le produit est
effacé sur la bonne feuille (s'il a été trouvé) ; cerise sur le gâteau : j'ai fait
ta dernière demande (celle de ton énoncé, pas de ton testament) : « si je fais
une erreur de famille dans la feuille base j'aimerais que la correction
se fasse juste en changeant de famille et non pas en effaçant et en
recommençant. » (ton vœu a été exaucé, et accompli ! )

---

code VBA (en 46 lignes) :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim cel As Range, sh1$, sh2$, pdt$, lg1&, lg2&
  With Target
    If .CountLarge > 1 Then Exit Sub
    If .Column <> 2 Then Exit Sub
    lg1 = .Row: If lg1 < 3 Then Exit Sub
    pdt = .Offset(, 1): If pdt = "" Then Exit Sub
    sh2 = .Value
  End With
  With Application
    .ScreenUpdating = 0: .EnableEvents = 0: .Undo
    sh1 = Target: Target = sh2: .EnableEvents = -1
  End With
  If sh1 <> "" And (sh2 = "" Or sh2 <> sh1) Then
    With Worksheets(sh1)
      Set cel = .Columns(1).Find(pdt, , -4163, 1, 1)
      If Not cel Is Nothing Then .Rows(cel.Row).Delete
    End With
  End If
  If sh2 = "" Then
    Application.EnableEvents = 0: Target = Empty
    Application.EnableEvents = -1
  Else
    With Worksheets(sh2)
      lg2 = .Cells(Rows.Count, 1).End(3).Row + 1
      With .Cells(lg2, 1)
        .Value = pdt                  'Produit
        .Offset(, 1) = Cells(lg1, 5)  'Prix d'achat HT
        .Offset(, 2) = Cells(lg1, 7)  'Prix de vente HT
        .Offset(, 3) = Cells(lg1, 12) 'Marge brute
      End With
    End With
  End If
End Sub

Private Sub Worksheet_Activate()
  Dim dlg&, i%: Application.ScreenUpdating = 0
  dlg = Cells(Rows.Count, 1).End(3).Row
  If dlg > 2 Then [A3].Resize(dlg - 2).ClearContents
  For i = 2 To Worksheets.Count
    Cells(i + 1, 1) = Worksheets(i).Name
  Next i
End Sub

si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis.

---

@bbb38 : à propos de ton problème de vue, inutile de consulter :
ta paire de lunettes est prête ; elle t'attend chez ton opticien
préféré ; adresse : module de "Feuil1 (Base)".

soan

 

[john.deuf]

Voila ce que j'ai demandé la première fois:

" Ce que je voudrais c'est faire une liste de produit dans un onglet, qui s'appel BASE qui peut s'allonger de jour en jour. Çà c'est fait.
Crée un menu déroulant dans lequel il y a le nom des autres onglet et que le fait de choisir, ça copie la ligne de A1 a A4 dans l'onglet correspondant ."

 

[john.deuf]

Voila ce que j'ai demandé la premiere fois.
"
Ce que je voudrais c'est faire une liste de produit dans un onglet, qui s'appel BASE qui peut s'allonger de jour en jour. Çà c'est fait.
Crée un menu déroulant dans lequel il y a le nom des autres onglet et que le fait de choisir, ça copie la ligne de A1 a A4 dans l'onglet correspondant "

 

[soan]

@john.deuf

on s'est croisés ! j'ai fait ton exo entièrement :
je te laisse lire mon très long post #5.

(tu peux cliquer sur le lien bleu pour aller dessus)

soan

 

[john.deuf]

Bonjour Soan,
déjà merci pour ton humour j'ai les larmes aux yeux..

Pinaise j'ai pas eu le temps de finir d’écrire mes message que tu as déjà fais les modifs.
Alors je viens d'essayer et, a premiere vue tout est nickel a part que la 1ere ligne s'inscri en ligne 2 dans les onglets au lieu de 3.
Si non a part ça, c'est de la balle.

 

[soan]

@john.deuf

merci pour ton retour !

tu as écrit : « à part que la 1ère ligne s'inscrit en ligne 2 dans les onglets au lieu de 3. »

alors tu préfères que la 2ème ligne reste vide ? soit ; dans ce cas,
il suffit d'ajouter une ligne de test :

    With Worksheets(sh2)
      lg2 = .Cells(Rows.Count, 1).End(3).Row + 1
      If lg2 = 2 Then lg2 = 3
      With .Cells(lg2, 1)

une seule ligne a été ajoutée, mais j'ai mis les autres lignes pour
que tu puisses situer l'endroit où elle doit être placée ; à toi de
résoudre le jeu des sept différences !

soan

 

[john.deuf]

et aussi la ventilation depuis la feuille base se fait que jusqu’à D au lieu de K

 

[soan]

c'est car sur tes feuilles de ventilation, y'avait que ces 4 colonnes :
"Produit" ; "Prix d'achat" ; "Prix de vente" ; "Marge"

alors indique-moi quelles sont toutes les colonnes que tu veux,
et dans l'ordre ! pour que tu me dises pas après : « ok, tout y
est, mais c'est pas dans cet ordre-là que j'le voulais ! »

---

et pour la 1ère feuille "Base", est-ce que tu préfères que le
1er produit soit en ligne 4 ? (et la ligne 3 sera vide)

pour la colonne A Catégorie : idem ? VVC en ligne 4
au lieu de 3 ?

soan

 

[john.deuf]

ah oui je vois je renvoi un fichier modifié tu vas comprendre

 

[john.deuf]

il faut que je m'absente,
merci pour ce que tu fais .
je reviens cet après midi.

 

[soan]

@john.deuf

désolé pour le retard, j'ai eu un contretemps !

ton fichier en retour.

---

Noms définis

Coef : =1,055 (inchangé)

Feuille : =DECALER(Base!$A$4;;;NBVAL(Base!$A:$A)-1)

---

Code VBA (43 lignes) :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim cel As Range, sh1$, sh2$, pdt$, lg1&, lg2&
  With Target
    If .CountLarge > 1 Then Exit Sub
    If .Column <> 2 Then Exit Sub
    lg1 = .Row: If lg1 < 3 Then Exit Sub
    pdt = .Offset(, 1): If pdt = "" Then Exit Sub
    sh2 = .Value
  End With
  With Application
    .ScreenUpdating = 0: .EnableEvents = 0: .Undo
    sh1 = Target: Target = sh2: .EnableEvents = -1
  End With
  If sh1 <> "" And (sh2 = "" Or sh2 <> sh1) Then
    With Worksheets(sh1)
      Set cel = .Columns(1).Find(pdt, , -4163, 1, 1)
      If Not cel Is Nothing Then .Rows(cel.Row).Delete
    End With
  End If
  If sh2 = "" Then
    Application.EnableEvents = 0: Target = Empty
    Application.EnableEvents = -1
  Else
    With Worksheets(sh2)
      lg2 = .Cells(Rows.Count, 1).End(3).Row + 1: If lg2 = 2 Then lg2 = 3
      Cells(lg1, 3).Resize(, 11).Copy: .Cells(lg2, 1).PasteSpecial -4163
      Application.CutCopyMode = 0
    End With
  End If
End Sub

Private Sub Worksheet_Activate()
  Dim dlg&, i%: Application.ScreenUpdating = 0
  dlg = Cells(Rows.Count, 1).End(3).Row
  If dlg > 3 Then [A4].Resize(dlg - 3).ClearContents
  For i = 2 To Worksheets.Count
    Cells(i + 2, 1) = Worksheets(i).Name
  Next i
End Sub

(utilisation identique)

soan