XL 2016 Modification d'une macro

john.deuf · 21 Janvier 2021

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

john.deuf · 23 Janvier 2021

Bonjour,
il semblerait que les onglets ajoutés ne vienne pas dans la liste catégorie
D'autre part, c'est chez moi ou c'est le site qui est long a la détente ?

john.deuf · 23 Janvier 2021

et décaler la colonne D fournisseurs en B

soan · 23 Janvier 2021

Bonsoir john.deuf, (réponse à ton post #16)

tu as écrit : «
il semblerait que les onglets ajoutés ne vienne pas dans la liste catégorie
»

tu as raison ; mea culpa, j'ai oublié d'enlever un Exit Sub que j'avais mis
par commodité pour travailler sur le fichier ; il était placé juste sous :
Private Sub Worksheet_Activate()

j'ai corrigé le fichier Excel, qui a remplacé celui de mon post #15 ;
j'ai aussi fait la correction dans le code VBA placé entre balises.

soan

soan · 23 Janvier 2021

@john.deuf, (réponse à ton post #17)

tu as écrit : « décaler la colonne D fournisseurs en B »

je vais travailler dessus ; à plus tard.

soan

soan · 23 Janvier 2021

@john.deuf

« décaler la colonne D fournisseurs en B »

c'est fait dans le fichier joint ci-dessous !

code VBA (42 lignes) :

VB:

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 <> 3 Then Exit Sub
    lg1 = .Row: If lg1 < 4 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(2).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, 2).End(3).Row + 1: If lg2 = 2 Then lg2 = 3
      Cells(lg1, 4).Resize(, 10).Copy: .Cells(lg2, 2).PasteSpecial -4163
      .Cells(lg2, 1) = Cells(lg1, 2)
    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

soan

john.deuf · 23 Janvier 2021

la ça marche du tonner mais je crois que j'ai oublier un truc que j'avais dans ma tête mais que je ne t’ai dit.
J'ai ajouté 2 colonnes regarde dans l'onglet VVC. Je vais le recopier dans tous les futurs onglets.
Je te joint le fichier

soan · 23 Janvier 2021

@john.deuf

nouvelle version, avec colonnes "Genre" et "Unité" en plus.

VB:

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 <> 3 Then Exit Sub
    lg1 = .Row: If lg1 < 4 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(2).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, 2).End(3).Row + 1: If lg2 = 2 Then lg2 = 3
      Cells(lg1, 4).Resize(, 12).Copy: .Cells(lg2, 2).PasteSpecial -4163
      .Cells(lg2, 1) = Cells(lg1, 2)
    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

soan

john.deuf · 26 Janvier 2021

Bonjour Soan,
j'ai pris le temps de tester et ...ça marche nickel, c'est exactement ce qu'il me fallait, je te remercie pour ton travail et ta patience et ta bonne humeur.
Maintenant pourrais tu m'indiquer comment faire si je devais ajouter des colonnes. Ce n'est pas a l'ordre du jour mais on ne sais jamais
D'autre part est ce que je peux faire appel à toi si je devais améliorer ou modifier ce classeur?
Belle journée.

soan · 27 Janvier 2021

Bonjour john.deuf,

tu as écrit : « j'ai pris le temps de tester et ...ça marche nickel,
c'est exactement ce qu'il me fallait »

alors c'est impeccable ! merci pour ton retour !

« pourrais-tu m'indiquer comment faire si je devais ajouter des colonnes ? »

de la même façon que je l'ai déjà fait quand j'ai ajouté les 2 colonnes
"Genre" et "Unité" : les ajouter sur chaque feuille de destination, donc ici
les 6 feuilles "VVC" à "Boisson alcool" ; les ajouter aussi sur la feuille
source "Base" ; ensuite, côté VBA, adapter en conséquence la sub
Worksheet_Change() ; mais attention : il ne faut pas tout changer !
ça concerne seulement le dernier With .. End With, pour l'écriture
des infos, donc ici :

VB:

    With Worksheets(sh2)
      lg2 = .Cells(Rows.Count, 2).End(3).Row + 1: If lg2 = 2 Then lg2 = 3
      Cells(lg1, 4).Resize(, 12).Copy: .Cells(lg2, 2).PasteSpecial -4163
      .Cells(lg2, 1) = Cells(lg1, 2)
    End With

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

et même, plus précisément encore, ces 2 lignes :

VB:

      Cells(lg1, 4).Resize(, 12).Copy: .Cells(lg2, 2).PasteSpecial -4163
      .Cells(lg2, 1) = Cells(lg1, 2)

la 1ère ligne est pour toutes les colonnes contigües à copier :
ce sont les 12 colonnes "Produit" à "Taux de marge", d'où
le .Resize(, 12) à partir de la colonne 4 (D).

la 2ème ligne est pour copier seulement le "Fournisseur",
en complément des colonnes contigües déjà copiées.

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

l'adaptation devra bien sûr être faite en tenant compte de l'emplacement
des nouvelles colonnes ajoutées ; note que tu n'as rien besoin de faire
pour la suppression d'une ligne (c'est en colonne C, quand tu effaces une
famille avec la touche Suppression, ou quand tu changes d'une famille
pour une autre).

tant que "Catégorie" reste en colonne A, inutile de changer la sub
Worksheet_Activate().

si plus tard tu dois améliorer ou modifier ce classeur, tu pourras bien sûr
compter sur moi, si ta nouvelle demande sera dans mes compétences.

comme je n'ai pas pu te répondre hier, je te souhaite une belle journée
pour aujourd'hui !

soan

soan · 29 Janvier 2021

Bonjour john.deuf,

Je m'suis rendu compte que j'ai mis dans mon code VBA cette partie qui est inutile :

VB:

  If sh2 = "" Then
    Application.EnableEvents = 0: Target = Empty
    Application.EnableEvents = -1

Tu peux donc simplifier ainsi la fin de la sub Worksheet_Change() :

VB:

  If sh2 = "" Then Exit Sub
  With Worksheets(sh2)
    lg2 = .Cells(Rows.Count, 2).End(3).Row + 1: If lg2 = 2 Then lg2 = 3
    Cells(lg1, 4).Resize(, 12).Copy: .Cells(lg2, 2).PasteSpecial -4163
    .Cells(lg2, 1) = Cells(lg1, 2)
  End With

Voici donc la sub complète :

VB:

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 <> 3 Then Exit Sub
    lg1 = .Row: If lg1 < 4 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(2).Find(pdt, , -4163, 1, 1)
      If Not cel Is Nothing Then .Rows(cel.Row).Delete
    End With
  End If
  If sh2 = "" Then Exit Sub
  With Worksheets(sh2)
    lg2 = .Cells(Rows.Count, 2).End(3).Row + 1: If lg2 = 2 Then lg2 = 3
    Cells(lg1, 4).Resize(, 12).Copy: .Cells(lg2, 2).PasteSpecial -4163
    .Cells(lg2, 1) = Cells(lg1, 2)
  End With
End Sub

désolé pour ~~mon omelette~~ ma boulette ! errare humanum est ! (c'est du latin)

ce que j'ai écrit dans mon post #24 reste valable ; j'espère que tu l'as lu.

soan

john.deuf · 29 Janvier 2021

Bonjour Soan,

merci pour ton message, je vais rectifier.
"errare humanum est " ça ne veux rien dire mais ça fait bien.

Je me disais qu’il pourrait y avoir une amélioration si c’est possible bien sur.

Si je veux changer un prix dans la feuille base, il faut que je supprime la famille, change le prix et remettre la famille.

Pourrait-on le faire sans devoir supprimer la famille ?

soan · 29 Janvier 2021

Bonjour @john.deuf,

tu as écrit : « "errare humanum est" ça ne veux rien dire »

si : "errare humanum est" veut dire "l'erreur est humaine"
(c'est une traduction du latin en français)

j'ai voulu dire que j'ai fait une erreur car je suis pas infaillible !

tu as écrit cette phrase : « Si je veux changer un prix dans la feuille base,
il faut que je supprime la famille, change le prix et remette la famille. »

oulah ! ça m'a l'air drôlement compliqué, ça ! si j'ai bien compris ta demande, ça voudrait dire ceci :

sur la feuille "Base", ligne 4 ou en dessous, colonnes G ; H ; L ; M : si tu changes un prix, faudrait rechercher sur toutes les autres feuilles les lignes qui ont le même "Produit" (plusieurs occurrences possibles) ; et pour chacune, modifier le prix correspondant des colonnes respectives E ; F ; J ; K.

de plus, sur la feuille "Base", ne rien changer pour ces colonnes de prix : I ; J ; K ; N car il y a des formules ; par contre, comme il y avait eu un coller en valeur (-4163 = xlPasteValues), alors sur toutes les autres feuilles, rechercher les lignes qui ont le même "Produit" (plusieurs occurrences possibles) ; et pour chacune, modifier le prix correspondant des colonnes respectives G ; H ; I ; L.

enfin, sur chaque ligne qui aura été modifiée sur toutes les feuilles "Famille", mettre à jour le Taux de marge (qui a lui aussi été copié en valeur).

c'est tellement compliqué qu'j'suis pas sûr que « le jeu en vaille la chandelle ! » ; peut-être qu'un autre intervenant aura une meilleure idée à proposer ? peut-être en utilisant PowerQuery ou des TCD ? (moi, j'connais pas suffisamment les TCD, et j'ai pas de PowerQuery sur mon Excel 2007)

je crois bien que le plus simple est de continuer à faire comme tu fais maintenant : changer le prix dans la feuille "Base" ; supprimer la famille, puis la remettre ; c'est un peu contraignant, mais faute de mieux...

suggestion : éventuellement, tu peux essayer de faire ton exo avec un logiciel de Base de données comme par exemple Microsoft Access ; plus d'infos dans mon post #34. (clique sur le lien bleu pour aller dessus)

soan

Staple1600 · 30 Janvier 2021

Bonsoir le fil

[Juste pour infos] (a)
Access n'est disponible que sur les versions PRO et/ou PME
En tout cas pas sur les versions Home et/ou étudiants
[/Juste pour infos]

[Juste pour infos] (b)
Bonne suggestion que celle d'utiliser TCD et/ou PowerQuery*
(installé en natif sur Excel 2016 <= préfixe de cette discussion)
D'autant plus au regard du souci exposé dans le message#1

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.

Privilégier une approche VBA, quand on ne maitrise pas le VBA, implique d'être tributaire du suivi du développement de l'appli
(par le contributeur original ou par N contributeurs)
Ce qui est plus chronophage que de s'initier soi-même à l'usage des fonctions natives d'Excel (formules, TCD ou PowerQuery)
Cela permet de continuer à utiliser son appli dans devoir attendre les modifications sur un classeur réalisés par des tiers, fussent-ils XLDnautes de bon aloi
[/Juste pour infos]

Ce n'est là qu'un avis personnel.
Ce n'est pas une critique des différents codes distillés par les précédents intervenants.

john.deuf · 30 Janvier 2021

Bonjour Soan et Staple 1600,
je me doutais bien que ça n'allais pas être une sinécure. Je vais donc continuer comme ça, ça marche déjà très bien.
Merci de vous être penché sur mon problème.
Belle journée.

Staple1600 · 30 Janvier 2021

Re,

=>john.deuf
Je n'ai pas fait grand chose.
Juste plussoyer la suggestion de soan d'utiliser les TCD ou PowerQuery.

soan à dit:
[...]
c'est tellement compliqué qu'j'suis pas sûr que « le jeu en vaille la chandelle ! »
[...]
peut-être en utilisant PowerQuery ou des TCD ?

Qui ne nécessite que d'avoir une bonne souris
(et un peu de pratique, mais il y a beaucoup de tutos sur XLD ou sur le net à propos des TCD et de PowerQuery)

XL 2016 Modification d'une macro

john.deuf

XLDnaute Junior

Pièces jointes

john.deuf

XLDnaute Junior

john.deuf

XLDnaute Junior

soan

XLDnaute Barbatruc

soan

XLDnaute Barbatruc

soan

XLDnaute Barbatruc

Pièces jointes

john.deuf

XLDnaute Junior

Pièces jointes

soan

XLDnaute Barbatruc

Pièces jointes

john.deuf

XLDnaute Junior

soan

XLDnaute Barbatruc

soan

XLDnaute Barbatruc

john.deuf

XLDnaute Junior

soan

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

john.deuf

XLDnaute Junior

Staple1600

XLDnaute Barbatruc

Discussions similaires