Remplissage de colonne automatique via VBA

Traouck

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

XLDnaute Barbatruc
Bonjour le fil,

Traouck
Pourquoi le 2 dans le nom de la procédure ci-dessous?
VB:
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

XLDnaute Barbatruc
Supporter XLD
Bonjour @Traouck,

Essayez ce code :
VB:
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é.
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re, bon aprés-midi à toi aussi mapomme ;)

Pour le fun (et suite à ce que je disais dans le message#2)
VB:
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
 

Staple1600

XLDnaute Barbatruc
Re

Suite (pour le fun 2)
Un peu plus court
VB:
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 ;))
VB:
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
 
Dernière édition:

Traouck

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

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

Staple1600

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

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

mapomme

XLDnaute Barbatruc
Supporter XLD
Re,

Pour le fun, t'as rien de plus court que mon fun du message#4?
Puisque tu me titilles:
VB:
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

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

Discussions similaires

Statistiques des forums

Discussions
311 715
Messages
2 081 822
Membres
101 821
dernier inscrit
hybroxis