Remplissage de colonne automatique via VBA

[Traouck]

Bonjour,
Je voudrais remplir automatiquement la colonne G en Fonction de F.
J'ai taper ce code dans VBA, mais cela ne marche pas et je ne trouve pas la solution

Private Sub Worksheet_Change2(ByVal Target As Range)
'rempilssage automatique des cellules
If Target.Count > 1 Then Exit Sub
If Target.Column <> 6 Or Target.Row = 1 Then Exit Sub
If Target.Value = "Free" Then
Target.Offset(0, 1).Value = Sheets("listes").Range("N14").Value
ElseIf Target.Value = "Orange" Then
Target.Offset(0, 1).Value = Sheets("listes").Range("N14").Value
ElseIf Target.Value = "Bouygues Tél" Then
Target.Offset(0, 1).Value = Sheets("listes").Range("N14").Value
ElseIf Target.Value = "Ecofleet" Then
Target.Offset(0, 1).Value = Sheets("listes").Range("N3").Value
Else
Target.Offset(0, 1).Value = ""
End If
End Sub

Quelqu'un peu m'aider?
Merci d'avance
Cédric

 

[Staple1600]

Bonjour le fil,

Traouck
Pourquoi le 2 dans le nom de la procédure ci-dessous?

Private Sub Worksheet_Change2(ByVal Target As Range)
'rempilssage automatique des cellules
If Target.Count > 1 Then Exit Sub
If Target.Column <> 6 Or Target.Row = 1 Then Exit Sub
If Target.Value = "Free" Then
Target.Offset(0, 1).Value = Sheets("listes").Range("N14").Value
ElseIf Target.Value = "Orange" Then
Target.Offset(0, 1).Value = Sheets("listes").Range("N14").Value
ElseIf Target.Value = "Bouygues Tél" Then
Target.Offset(0, 1).Value = Sheets("listes").Range("N14").Value
ElseIf Target.Value = "Ecofleet" Then
Target.Offset(0, 1).Value = Sheets("listes").Range("N3").Value
Else
Target.Offset(0, 1).Value = ""
End If
End Sub

NB: Il ne peut y avoir qu'une seule procédure Private Sub Worksheet_Change(ByVal Target As Range)
Une seule (pas deux) 😉

 

[mapomme]

Bonjour @Traouck,

Essayez ce code :

Private Sub Worksheet_Change(ByVal Target As Range)
'remplissage automatique des cellules
  If Target.Count > 1 Then Exit Sub
  If Target.Column <> 6 Or Target.Row = 1 Then Exit Sub
  If Target.Value = "Free" Or Target.Value = "Orange" Or Target.Value = "Bouygues Tél" Then
    Target.Offset(0, 1) = Sheets("listes").Range("N14").Value
  ElseIf Target.Value = "Ecofleet" Then
    Target.Offset(0, 1) = Sheets("listes").Range("N3").Value
  Else
    Target.Offset(0, 1).Value = ""
  End If
End Sub

Si ça ne marche point, joignez un fichier exemple anonymisé.

 

[Staple1600]

Re, bon aprés-midi à toi aussi mapomme 😉

Pour le fun (et suite à ce que je disais dans le message#2)

Private Sub Worksheet_Change(ByVal T As Range)
Dim vArr, vArrr
'remplissage automatique des cellules
If T.Count > 1 Then Exit Sub
If T.Column <> 6 Or T.Row = 1 Then Exit Sub
vArr = Array("Free", "Bouygues Tél", "Orange", "Ecofleet"): vArrr = Array("N14", "N14", "N14", "N3")
On Error Resume Next
With Application
T.Offset(, 1) = Sheets("listes").Range(.Index(vArrr, .Match(T, vArr, 0)))
End With
End Sub

 

[mapomme]

Re @Staple1600 🙂,
À force de te croiser au fil des fils, je ne sais plus si je t'ai déjà salué ou non. Par fainéantise, je ne te (re)salue pas 😛. C'est dit et fait pour le reste de la journée.

 

[Staple1600]

Re

mapomme
Ok c'est noté
Pour le fun, t'as rien de plus court que mon fun du message#4?
(en guise de digestif) 😉

 

[Staple1600]

Re

Suite (pour le fun 2)
Un peu plus court

Private Sub Worksheet_Change(ByVal T As Range)
Dim vArr
If T.Count > 1 Then Exit Sub
If T.Column <> 6 Or T.Row = 1 Then Exit Sub
vArr = Array("Free", "Bouygues Tél", "Orange", "Ecofleet")
On Error Resume Next
With Application
T.Offset(, 1) = Sheets("listes").Range("N" & Choose(.Match(T, vArr, 0), 14, 14, 14, 3))
End With
End Sub

Et une petit variante (pour la petite sœur... du digestif 😉)

Private Sub Worksheet_Change(ByVal T As Range)
Set f = Sheets("listes")
If T.Count > 1 And T.Column <> 6 And T.Row = 1 Then Exit Sub
On Error Resume Next
With Application
T(1, 2) = f.Cells(Choose(.Match(T, Array("Free", "Bouygues Tél", "Orange", "Ecofleet"), 0), 14, 14, 14, 3), 14)
End With
End Sub

 

[Traouck]

il y a un 2 parce qu'il y a déjà un 1 qui rempli d'autres cellules en fonction de la colonne E.
Et je voulais juste compléter la saisie automatique.
Le fichier est un peu gros, c'est pour ça que je ne l'ai pas mis en ligne

 

[Traouck]

Private Sub Worksheet_Change(ByVal Target As Range)
'rempilssage automatique des cellules
If Target.Count > 1 Then Exit Sub
If Target.Column <> 5 Or Target.Row = 1 Then Exit Sub
If Target.Value = "Clients" Then
Target.Offset(0, 2).Value = Sheets("Listes").Range("R3").Value
Target.Offset(0, 4).Value = Sheets("Renseignements").Range("H5").Value
Target.Offset(0, 5).Value = Sheets("listes déroulante").Range("F3").Value
Target.Offset(0, 7).Value = Sheets("Renseignements").Range("F5").Value
ElseIf Target.Value = "Taxes et charges" Then
Target.Offset(0, 4).Value = Sheets("Renseignements").Range("H5").Value
Target.Offset(0, 5).Value = Sheets("listes déroulante").Range("F2").Value
Target.Offset(0, 6).Value = Sheets("listes déroulante").Range("G2").Value
Target.Offset(0, 7).Value = Sheets("Renseignements").Range("F6").Value
ElseIf Target.Value = "Effectifs" Then
Target.Offset(0, 4).Value = Sheets("Renseignements").Range("H5").Value
Target.Offset(0, 5).Value = Sheets("listes déroulante").Range("F2").Value
Target.Offset(0, 6).Value = Sheets("listes déroulante").Range("G3").Value
Target.Offset(0, 7).Value = Sheets("Renseignements").Range("F7").Value
ElseIf Target.Value = "Autres" Then
Target.Offset(0, 7).Value = Sheets("Renseignements").Range("F7").Value
ElseIf Target.Value = "Fournisseurs" Then
Target.Offset(0, 2).Value = Sheets("Listes").Range("L3").Value
Target.Offset(0, 4).Value = Sheets("Renseignements").Range("H5").Value
Target.Offset(0, 5).Value = Sheets("listes déroulante").Range("F2").Value
Target.Offset(0, 6).Value = Sheets("listes déroulante").Range("G2").Value
Target.Offset(0, 7).Value = Sheets("Renseignements").Range("F6").Value
ElseIf Target.Value = "" Then
Target.Offset(0, 2).Value = ""
Target.Offset(0, 4).Value = ""
Target.Offset(0, 5).Value = ""
Target.Offset(0, 6).Value = ""
Target.Offset(0, 7).Value = ""
Else
Target.Offset(0, 4).Value = Sheets("Renseignements").Range("H5").Value
Target.Offset(0, 5).Value = Sheets("listes déroulante").Range("F2").Value
Target.Offset(0, 6).Value = Sheets("listes déroulante").Range("G2").Value
Target.Offset(0, 7).Value = Sheets("Renseignements").Range("F6").Value
End If
End Sub

Private Sub Worksheet_Change2(ByVal Target As Range)
'rempilssage automatique des cellules
If Target.Count > 1 Then Exit Sub
If Target.Column <> 6 Or Target.Row = 1 Then Exit Sub
If Target.Value = "Free" Then
Target.Offset(0, 1).Value = Sheets("listes").Range("N14").Value
ElseIf Target.Value = "Orange" Then
Target.Offset(0, 1).Value = Sheets("listes").Range("N14").Value
ElseIf Target.Value = "Bouygues Tél" Then
Target.Offset(0, 1).Value = Sheets("listes").Range("N14").Value
ElseIf Target.Value = "Ecofleet" Then
Target.Offset(0, 1).Value = Sheets("listes").Range("N3").Value
Else
Target.Offset(0, 1).Value = ""
End If
End Sub

 

[Traouck]

vous faites comment pour coller en format vba??

 

[Staple1600]

Re

Traouck
Euh, normalement celle qui a un 2 dans son nom ne doit jamais s’exécuter si je n'abuse!
Comme déjà dit (voir message#2), il ne peut y en avoir qu'une procédure nommée Worksheet_Change() et doit voir son nom inchangé.

Tu as testé mes propositions et/ou celle de mapomme?

PS: On ne joint jamais un fichier original
On créé un fichier exemple allégé et simplifié pour juste illustrer la problématique rencontrée.
(sans oublier bien sûr d'anonymiser le fichier avant envoi)

NB: Pour formater le code VBA dans les messages sur le forum
(Voir explications dans ma signature (entre autres possibilités))

 

[Traouck]

j'ai bien compris qu'il ne peut y en avoir qu'une. C'est pour ça que j'ai mis la une en ligne. Sinon je pourrais essayer n'importe quelle proposition ça ne marchera pas tant qu'il y aura la 1. Hors la une est plus importante.
Mais il y a peut être moyen d'incorporer la deux dans la une.

 

[Staple1600]

Re

Bis repetita placent
As-tu testé nos propositions ?

Et encore une fois, celle qui s'appelle Worksheet_Change2 ne lancera jamais automatiquement.

 

[mapomme]

Re,

Pour le fun, t'as rien de plus court que mon fun du message#4?

Puisque tu me titilles:

Private Sub Worksheet_Change(ByVal Target As Range)
'remplissage automatique des cellules
  If Target.Count > 1 Then Exit Sub
  If Target.Column <> 6 Or Target.Row = 1 Then Exit Sub
  Target.Offset(, 1).FormulaR1C1 = _
    "=IFERROR(IF(RC[-1]=""Ecofleet"",R3C14,IF(MATCH(RC[-1],{""Free"";""Bouygues Tél"";""Orange""},0)>0,R14C14)),"""")"
  Target.Offset(, 1) = Target.Offset(, 1)
End Sub

 

[Staple1600]

Re

Si je n'abuse (mais je pourrais à cause du digestif😉)
Dans ton fun, tu ne pointes jamais sur la feuille listes, non?

PS: Tu valides mon observation quand à la non-exécution d'une procédure événementielle avec du 2 dans son nom?
(histoire de me rassurer 😉 )