Remplissage automatique selon critères (Macro)

[Arnaud dit Citro]

Bonjour à tous,

J'ai, dans mon fichier, créé un formulaire de création de vendeur. Lorsque je valide cela remplit des cellules dans une feuille que j'ai nommée "BdD_Vendeur", mais cela remplit aussi une autre feuille "Devis" à la suite des colonnes déjà existantes.

Private Sub CommandButton1_Click()

' Insertion dans la feuille Base de Données Vendeurs

Fve = Sheets("BdD_Vendeur").Range("A65536").End(xlUp).Row + 1

Sheets("BdD_Vendeur").Cells(Fve, 1) = TextBox1.Text 'colonne A
Sheets("BdD_Vendeur").Cells(Fve, 2) = TextBox2.Text 'colonne B
Sheets("BdD_Vendeur").Cells(Fve, 3) = Label5 'colonne C


' Création Vendeur et formule dans feuille Devis

Sheets("Devis").Select
    Range("Y7").Select
    ActiveCell.FormulaR1C1 = "=R[-4]C[-7]"
    Range("Z7").Select
    ActiveCell.FormulaR1C1 = "Accepté"
    Range("AA7").Select
    ActiveCell.FormulaR1C1 = "Reporté"
    Range("AB7").Select
    ActiveCell.FormulaR1C1 = "Refusé"
    Range("Y2").Select
    ActiveCell.FormulaR1C1 = "=SUMPRODUCT((RC13=BdD_Vendeur!R4C1:R999C1)*1)"
    Range("Z2").Select
    ActiveCell.FormulaR1C1 = "=IF(AND(R3C18=RC13,RC18=""Accepté""),1,0)"
    Range("AA2").Select
    ActiveCell.FormulaR1C1 = "=IF(AND(R3C18=RC13,RC18=""Reporté""),1,0)"
    Range("AB2").Select
    ActiveCell.FormulaR1C1 = "=IF(AND(R3C18=RC13,RC18=""Refusé""),1,0)"
    Range("Y2:AB2").Select
    Selection.Copy
    Range("Y8").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("Y8:AB19")
    Range("Y8:AB19").Select
    Range("R3").Select
    ActiveCell.FormulaR1C1 = "=BdD_Vendeur!R[1]C[-17]"
    Range("A8").Select
    
    
' Retour Accueil
Sheets("Accueil").Activate

Unload Me

End Sub

Cela créé donc 4 nouvelles colonnes à partir d'Y2 (Y2, Z2, AA2, AB2) plus une copie en Y8 plus un égal en R3 (enfin quand je dis "créé 4 nouvelles colonnes, pas tout à fait, cela ne fait que remplir).

En fait ce je voudrais faire, c'est que sur cette feuille "Devis" cela créé automatiquement les 4 colonnes à la suite de la dernière utilisée (soit la colonne X, si il n'y aucun vendeur) au fur et à mesure de la création de vendeur.
Le 1er vendeur serait tel que (en Y2, copie Y8 et R3), le second à la suite (donc en AC2, copie AC8 et S3), le 3ème à la suite et ainsi de suite, le tout automatiquement à la validation de la création du vendeur...

Je ne suis pas sur que ce soit faisable, mais si vous avez des idées, je suis preneur.

Bonne journée à tous

Arnaud

 

[Staple1600]

Bonjour le fil

Juste pour infos et conseils
Il est préférable (pour une plus grande fluidité du code d'éviter dans la mesure du possible les Select, Activate etc...)
Ci-dessous ton code réécrit en suivant ce conseil

Private Sub CommandButton1_Click()
' Insertion dans la feuille Base de Données Vendeurs
Fve = Sheets("BdD_Vendeur").Range("A65536").End(xlUp).Row + 1
Sheets("BdD_Vendeur").Cells(Fve, 1) = TextBox1.Text 'colonne A
Sheets("BdD_Vendeur").Cells(Fve, 2) = TextBox2.Text 'colonne B
Sheets("BdD_Vendeur").Cells(Fve, 3) = Label5 'colonne C
' Création Vendeur et formule dans feuille Devis
With Sheets("Devis")
    .Range("Y7").FormulaR1C1 = "=R[-4]C[-7]"
    .Range("Z7") = "Accepté"
    .Range("AA7") = "Reporté"
    .Range("AB7") = "Refusé"
    .Range("Y2").FormulaR1C1 = "=SUMPRODUCT((RC13=BdD_Vendeur!R4C1:R999C1)*1)"
    .Range("Z2") = "=IF(AND(R3C18=RC13,RC18=""Accepté""),1,0)"
    .Range("AA2") = "=IF(AND(R3C18=RC13,RC18=""Reporté""),1,0)"
    .Range("AB2").FormulaR1C1 = "=IF(AND(R3C18=RC13,RC18=""Refusé""),1,0)"
    .Range("Y2:AB2").Copy .Range("Y8")
    Application.CutCopyMode = False
    .Range("Y8").AutoFill Destination:=Range("Y8:AB19")
    .Range("R3").FormulaR1C1 = "=BdD_Vendeur!R[1]C[-17]"
End With
' Retour Accueil
Sheets("Accueil").Activate
Unload Me
End Sub

Normalement il produit le même résultat que l'original, non ?

 

[Arnaud dit Citro]

Bonjour Staple1600,

Merci pour ce conseil.

J'ai fait un test mais cela met un message d'erreur "Erreur d'exécution '1004': La méthode Autofill de la classe Range a échoué." et cette ligne .Range("Y8").AutoFill Destination:=Range("Y8:AB19") en jaune.

 

[Staple1600]

Re

Je vais de ce pas faire le test( que j'aurai du faire avant de modifier le code à la volée
Me culpa

 

[Staple1600]

Re

Donc cette fois-ci, j'ai testé
Et sur mon PC, cela produit le même résultat que ton code initial

Private Sub CommandButton1_Click()
' Insertion dans la feuille Base de Données Vendeurs
With Sheets("BdD_Vendeur")
  Fve = .Cells(Rows.Count, 1).End(xlUp).Row + 1
  .Cells(Fve, 1).Resize(, 3) = Array(TextBox1, TextBox2, Label5)
End With
' Création Vendeur et formule dans feuille Devis
With Sheets("Devis")
    .Range("Y7").FormulaR1C1 = "=R[-4]C[-7]"
    .Range("Z7:AB7") = Array("Accepté", "Reporté", "Refusé")
    .Range("Y2").FormulaR1C1 = "=SUMPRODUCT((RC13=BdD_Vendeur!R4C1:R999C1)*1)"
    .Range("Z2") = "=IF(AND(R3C18=RC13,RC18=""Accepté""),1,0)"
    .Range("AA2") = "=IF(AND(R3C18=RC13,RC18=""Reporté""),1,0)"
    .Range("AB2").FormulaR1C1 = "=IF(AND(R3C18=RC13,RC18=""Refusé""),1,0)"
    .Range("Y2:AB2").Copy .Range("Y8")
    Application.CutCopyMode = False
    .Range("Y8:AB8").AutoFill Destination:=.Range("Y8:AB19")
    .Range("R3").FormulaR1C1 = "=BdD_Vendeur!R[1]C[-17]"
End With
' Retour Accueil
Sheets("Accueil").Activate
Unload Me
End Sub

 

[Arnaud dit Citro]

Tout à fait, merci beaucoup, je vais essayer de comprendre ce que tu as fait

Il ne nous reste "plus qu'à" voir si mon problème de base a une solution

 

[Staple1600]

Re

Pour le fun (et parce ce qu'il fallait que j'occupe mon temps en attendant que mon thé infuse)
Cette syntaxe doit également produire le même résultat

Private Sub CommandButton1_Click()
Dim Formules
Formules = _
  Array("=SUMPRODUCT((RC13=BdD_Vendeur!R4C1:R999C1)*1)", "=IF(AND(R3C18=RC13,RC18=""Accepté""),1,0)", _
  "=IF(AND(R3C18=RC13,RC18=""Reporté""),1,0)", "=IF(AND(R3C18=RC13,RC18=""Refusé""),1,0)")
Sheets("BdD_Vendeur").Cells(Rows.Count, 1).End(3)(2).Resize(, 3) = Array(TextBox1, TextBox2, Label5)
With Sheets("Devis")
    .[Y7] = "=R[-4]C[-7]": .[Z7:AB7] = Array("Accepté", "Reporté", "Refusé")
    .Range("Y2:AB2") = Formules: .[Y2:AB2].Copy .[Y8]: Application.CutCopyMode = False
    .[Y8:AB8].AutoFill Destination:=.[Y8:AB19]: .[R3] = "=BdD_Vendeur!R[1]C[-17]"
End With
Sheets("Accueil").Activate: Unload Me
End Sub

Si tu as des questions sur cette dernière syntaxe, je te répondrai volontiers
Sinon utilises celle du message#5 (si tu veux éviter les Select/Activate comme le conseillent la plupart des membres "répondants" d'XLD )
Bonne journée.

 

[Staple1600]

RE

Pour revenir à ce que tu demandais dans ton premier message
Cette macro copie les données sur la feuille Devis vers la droite

Private Sub CommandButton1_Click()
Dim DerCol&, Formules
Formules = _
  Array("=SUMPRODUCT((RC13=BdD_Vendeur!R4C1:R999C1)*1)", "=IF(AND(R3C18=RC13,RC18=""Accepté""),1,0)", _
  "=IF(AND(R3C18=RC13,RC18=""Reporté""),1,0)", "=IF(AND(R3C18=RC13,RC18=""Refusé""),1,0)")
Sheets("BdD_Vendeur").Cells(Rows.Count, 1).End(3)(2).Resize(, 3) = Array(TextBox1, TextBox2, Label5)
With Sheets("Devis")
    DerCol = .Cells(7, Columns.Count).End(xlToLeft).Column
    .Cells(7, DerCol + 1) = TextBox1
    .Cells(7, DerCol + 2).Resize(, 3) = Array("Accepté", "Reporté", "Refusé")
    .Cells(2, DerCol + 1).Resize(, 4) = Formules
    .Cells(2, DerCol + 1).Resize(, 4).Copy .Cells(8, DerCol + 1): Application.CutCopyMode = False
    .Cells(8, DerCol + 1).Resize(, 4).AutoFill Destination:=.Cells(8, DerCol + 1).Resize(12, 4)
End With
Sheets("Accueil").Activate: Unload Me
End Sub

Est-ce qu'on se rapproche de ce tu souhaites faire?

EDITION: Bonjour frangy

 

[frangy]

Bonjour à tous,

Je me suis également penché sur le sujet.
Proposition à tester ...

Cordialement.

 

[Arnaud dit Citro]

Re Staple1600 et bonjour Frangy,

Merci de vous pencher sur mon problème

Je fais des tests et je vous dis ça

 

[Arnaud dit Citro]

Re à tous les deux,

Waouuuuu, ça marche du feu de dieu !!!! c'est encore mieux que je le pensais.

Staple1600, je ne sais pas pourquoi, il commence à ajouter à partir de la colonne U (au lieu de X, il y a pourtant des formules dans X, j'ai modifié pour qu'il mette des 0 au cas ou mais ça ne change rien) et dans la colonne où il y a "Accepté" il met une date (00/01/1900), par contre au second vendeur et les suivants cela semble être correct.
Et oui, j'aurai besoin d'explication sur la précédente syntaxe (Array en particulier).

Frangy, cela fonctionne parfaitement, mais là encore je vais avoir besoin d'explications.
Tu as ajouté "As Long" et "As Integer" aux variables, à quoi correspondent ces deux codes?
Je présume que je peux l'adapter à n'importe quelle feuille en remplaçant "With Sheets("Devis")" par "With Sheets("feuillexxx")"?
Si je veux que l'Autofill se fasse sur plus de lignes (j'avais mis Y8:AB19 pour faire des essais mais ce sera probablement sur près de 800 lignes), ou dois je faire la modif?
A quoi correspond Resize dans les lignes de codes avec If?

Question à tous les deux : le point que vous mettez avant Range ou Cells est utilisé parce qu'il y a With? lorsque vous mettez With, c'est pour remplacer les Select ou Activate?

Houlala, il y a plein de questions qui me viennent à l'esprit, ça va prendre des heures pour que je comprenne !!!

Dans tous les cas, un très grand merci à tous les deux

Arnaud

 

[Staple1600]

Re

Avec le With/End With, effectivement le point est très important.

Pour l'utilisation d'Array telle que je l'ai faite
On peut quand les cellules sont adjacentes, remplacer la syntaxe usuelle
Range("A1")=1
Range("B1")=2
Range("C1")=3
par
Range("A1:C1")=Array(1,2,3)
Cela fonctionne aussi avec des formules
(cf le tableau (ou Array) nommé Formules)

Pour le Resize, cela permet de redimensionner une plage de cellules
Exemple avec cette petite macro de test

Sub Test()
MsgBox Range("A1").Address
MsgBox Cells(1, 1).Address
MsgBox Cells(1, 1).Resize(2, 2).Address
MsgBox Cells(1, 1).Resize(, 10).Address
MsgBox Cells(1, 1).Resize(10).Address
End Sub

 

[frangy]

Tu as ajouté "As Long" et "As Integer" aux variables, à quoi correspondent ces deux codes ?
La déclaration des variables n'est pas obligatoire mais fortement recommandée. Elle peut aider à résoudre plus facilement les problèmes lors du développement. De plus, les programmes dépensent moins de mémoire vive avec des déclarations adaptées.
Le type de la variable indique la nature de son contenu (texte, nombres, date, etc.).
Si tu ne spécifies pas le type de données, la variable est convertie en type Variant qui correspond à tout type de valeur et peut être converti en tout autre type si sa valeur est convertible.
Exemple : Dim Fve

Long (entier long) correspond à un nombre entier compris entre – 2 147 483 648 et 2 147 483 647.
Exemple : Dim Fve As Long
Ce type est adapté pour le nombre de lignes (1048576 maximum)

Integer (entier) correspond à un nombre entier compris entre -32 768 et 32 767.
Ce type est adapté pour le nombre de colonnes (16384 maximum)

Je présume que je peux l'adapter à n'importe quelle feuille en remplaçant "With Sheets("Devis")" par "With Sheets("feuillexxx")"?
L’ instruction With...End With, permet d’éviter la répétition dans une série d'instructions qui font référence à un même objet. C’est une simplification de l’écriture.
Ton exemple avec une feuille est correct et tu peux l’étendre à d’autres objets.
Tu peux même imbriquer les instructions.
Exemple :

Sub Test()
    With Worksheets("Feuil1").Cells(1, 1)
        .Formula = "=SQRT(50)"
        With .Font
            .Name = "Arial"
            .Bold = True
            .Size = 8
        End With
    End With
End Sub

Si je veux que l'Autofill se fasse sur plus de lignes (j'avais mis Y8:AB19 pour faire des essais mais ce sera probablement sur près de 800 lignes), ou dois je faire la modif?
A quoi correspond Resize dans les lignes de codes avec If?
Comme indiqué par Staple1600, le Resize, permet de redimensionner une plage de cellules.
.Cells(8, 25) correspond à Y8
.Cells(8, 25).Resize(, 4) correspond à Y8:AB8
.Cells(8, 25).Resize(12, 4) correspond à Y8:AB19
.Cells(8, 25).Resize(800, 4) correspond à Y8:AB807

Question à tous les deux : le point que vous mettez avant Range ou Cells est utilisé parce qu'il y a With?
Oui

Lorsque vous mettez With, c'est pour remplacer les Select ou Activate ?
Je ne reviens pas sur l’explication de l’instruction With...End With.
Par contre, il est préférable d’éviter (autant que possible) l’utilisation des méthodes Select ou Activate. Il vaut mieux désigner explicitement l’objet sur lequel s’applique l’instruction.
A noter toutefois que certaines opérations nécessitent l'activation d'une feuille de calcul ou d'un classeur avant de pouvoir être réalisées.

 

[Arnaud dit Citro]

Merci à tous les deux pour ces explications, je comprends un peu mieux maintenant. Je vais me mettre cette discussion en favori