copier / Coller les valeurs avec conditions...

Bonsoir,

....copie cette valeur dans la dernière cellule vide de la colonne A

Ceci dans le module de la feuille en question
'------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Double
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("d2:d" & Cells(Rows.Count, "c").End(xlUp).Row)) Is Nothing Then
If UCase(Target) = "D" Then
x = Target.Offset(, -1).Value
With Sheets("Devis")
.Range("a" & .Cells(.Rows.Count, "a").End(xlUp).Row + 1) = x
End With
End If
End If
End Sub
'--------------------

--
Salutations
JJ


"Manu" a écrit dans le message de news: lv7d7m$b4$

Bonsoir,

Ca ressemble à une ficelle précédente où Jacky et Mich m'avait solutionné le problème, j'ai tenté avec ce
qu'ils m'ont donné d'adapter... mais vraiment impossible ! Aussi, je vous demande encore un coup de main....

J'ai dans une colonne C des formules
Je souhaiterais que lorsque je tape "D" (peu importe la casse) dans la col D qu'il me copie la valeur de la
cellule à la gauche de où j'ai tapé "D" et qu'il me copie cette valeur dans la dernière cellule vide de la
colonne A de la Feuil "Devis"

Me suis je fais comprendre...

Encore merci pour votre aide !

Manu

---
Ce courrier électronique ne contient aucun virus ou logiciel malveillant parce que la protection avast!
Antivirus est active.
http://www.avast.com

Ca bug dès la la 1ère ligne.... Private Sub Worksheet_Change(ByVal Target As
Range)
Est-ce dû que j'ai déjà une autre macro que m'avait réalisé Mich qui
commence de la même façon mais pour autre chose...
Ne peut-on pas avoir le même Private Sub Worksheet_Change(ByVal Target As
Range) de la même Feuil pour diverses éléments souhaités...

Merci

Manu

"Jacky" a écrit dans le message de groupe de discussion :
lv7gif$95m$

Bonsoir,

....copie cette valeur dans la dernière cellule vide de la colonne A

Ceci dans le module de la feuille en question
'------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Double
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("d2:d" & Cells(Rows.Count,
"c").End(xlUp).Row)) Is Nothing Then
If UCase(Target) = "D" Then
x = Target.Offset(, -1).Value
With Sheets("Devis")
.Range("a" & .Cells(.Rows.Count, "a").End(xlUp).Row + 1) = x
End With
End If
End If
End Sub
'--------------------

--
Salutations
JJ


"Manu" a écrit dans le message de news:
lv7d7m$b4$

Bonsoir,

Ca ressemble à une ficelle précédente où Jacky et Mich m'avait solutionné
le problème, j'ai tenté avec ce qu'ils m'ont donné d'adapter... mais
vraiment impossible ! Aussi, je vous demande encore un coup de main....

J'ai dans une colonne C des formules
Je souhaiterais que lorsque je tape "D" (peu importe la casse) dans la col
D qu'il me copie la valeur de la cellule à la gauche de où j'ai tapé "D"
et qu'il me copie cette valeur dans la dernière cellule vide de la colonne
A de la Feuil "Devis"

Me suis je fais comprendre...

Encore merci pour votre aide !

Manu

---
Ce courrier électronique ne contient aucun virus ou logiciel malveillant
parce que la protection avast! Antivirus est active.
http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com

---
Ce courrier électronique ne contient aucun virus ou logiciel malveillant parce que la protection avast! Antivirus est active.
http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com

Re...
Il faudra l'integré dans la même macro "Worksheet_Change" dejà existante
Donne la macro que tu utilises.

--
Salutations
JJ


"Manu" a écrit dans le message de news: lv7h3q$aij$

Ca bug dès la la 1ère ligne.... Private Sub Worksheet_Change(ByVal Target As Range)
Est-ce dû que j'ai déjà une autre macro que m'avait réalisé Mich qui commence de la même façon mais pour
autre chose...
Ne peut-on pas avoir le même Private Sub Worksheet_Change(ByVal Target As Range) de la même Feuil pour
diverses éléments souhaités...

Merci

Manu

"Jacky" a écrit dans le message de groupe de discussion : lv7gif$95m$

Bonsoir,

....copie cette valeur dans la dernière cellule vide de la colonne A

Ceci dans le module de la feuille en question
'------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Double
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("d2:d" & Cells(Rows.Count, "c").End(xlUp).Row)) Is Nothing Then
If UCase(Target) = "D" Then
x = Target.Offset(, -1).Value
With Sheets("Devis")
.Range("a" & .Cells(.Rows.Count, "a").End(xlUp).Row + 1) = x
End With
End If
End If
End Sub
'--------------------

--
Salutations
JJ


"Manu" a écrit dans le message de news: lv7d7m$b4$

Bonsoir,

Ca ressemble à une ficelle précédente où Jacky et Mich m'avait solutionné le problème, j'ai tenté avec ce
qu'ils m'ont donné d'adapter... mais vraiment impossible ! Aussi, je vous demande encore un coup de
main....

J'ai dans une colonne C des formules
Je souhaiterais que lorsque je tape "D" (peu importe la casse) dans la col D qu'il me copie la valeur de la
cellule à la gauche de où j'ai tapé "D" et qu'il me copie cette valeur dans la dernière cellule vide de la
colonne A de la Feuil "Devis"

Me suis je fais comprendre...

Encore merci pour votre aide !

Manu

---
Ce courrier électronique ne contient aucun virus ou logiciel malveillant parce que la protection avast!
Antivirus est active.
http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com

---
Ce courrier électronique ne contient aucun virus ou logiciel malveillant parce que la protection avast!
Antivirus est active.
http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com

La voici...

Set Rg = Intersect(Target, Range("C:C"))
'Mich
If Not Rg Is Nothing Then
For Each C In Rg
Call Création_Répertoire(C)
Next
End If

Set Rg = Intersect(Target, Range("D:D"))
If Not Rg Is Nothing Then
If Rg.Cells.Count = 1 Then
If LCase(Rg) = "x" Then
LeRep = Chemin & Rg.Offset(, -1)
If Dir(LeRep, vbDirectory) = "" Then
Call Création_Répertoire(Rg.Offset(, -1))
Application.Wait (Now() + TimeValue("00:00:02"))
Application.EnableEvents = False
End If
If Rg.Offset(, -1) = "" Then Exit Sub
Call Choisir_Le_Fichier(LeRep & "")
Application.EnableEvents = False
Rg = ""
Application.EnableEvents = True
End If
End If
End If
End Sub

Manu


"Jacky" a écrit dans le message de groupe de discussion :
lv7hgc$bgj$

Re...
Il faudra l'integré dans la même macro "Worksheet_Change" dejà existante
Donne la macro que tu utilises.

--
Salutations
JJ


"Manu" a écrit dans le message de news:
lv7h3q$aij$

Ca bug dès la la 1ère ligne.... Private Sub Worksheet_Change(ByVal Target
As Range)
Est-ce dû que j'ai déjà une autre macro que m'avait réalisé Mich qui
commence de la même façon mais pour autre chose...
Ne peut-on pas avoir le même Private Sub Worksheet_Change(ByVal Target As
Range) de la même Feuil pour diverses éléments souhaités...

Merci

Manu

"Jacky" a écrit dans le message de groupe de discussion :
lv7gif$95m$

Bonsoir,

....copie cette valeur dans la dernière cellule vide de la colonne A

Ceci dans le module de la feuille en question
'------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Double
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("d2:d" & Cells(Rows.Count,
"c").End(xlUp).Row)) Is Nothing Then
If UCase(Target) = "D" Then
x = Target.Offset(, -1).Value
With Sheets("Devis")
.Range("a" & .Cells(.Rows.Count, "a").End(xlUp).Row + 1) = x
End With
End If
End If
End Sub
'--------------------

--
Salutations
JJ


"Manu" a écrit dans le message de news:
lv7d7m$b4$

Bonsoir,

Ca ressemble à une ficelle précédente où Jacky et Mich m'avait solutionné
le problème, j'ai tenté avec ce qu'ils m'ont donné d'adapter... mais
vraiment impossible ! Aussi, je vous demande encore un coup de main....

J'ai dans une colonne C des formules
Je souhaiterais que lorsque je tape "D" (peu importe la casse) dans la
col D qu'il me copie la valeur de la cellule à la gauche de où j'ai tapé
"D" et qu'il me copie cette valeur dans la dernière cellule vide de la
colonne A de la Feuil "Devis"

Me suis je fais comprendre...

Encore merci pour votre aide !

Manu

---
Ce courrier électronique ne contient aucun virus ou logiciel malveillant
parce que la protection avast! Antivirus est active.
http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com

---
Ce courrier électronique ne contient aucun virus ou logiciel malveillant
parce que la protection avast! Antivirus est active.
http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com

---
Ce courrier électronique ne contient aucun virus ou logiciel malveillant parce que la protection avast! Antivirus est active.
http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com

Re...

Il manque une partie du code au début...
Si j'ai bien compris tu peux avoir un "x" ou un "D" dans la colonne D
Ajoute ceci à la fin du code Juste avant le "End Sub"
'--
'---------Concerne la saisie de "D" de la colonne D-------------------
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("d2:d" & Cells(Rows.Count, "c").End(xlUp).Row)) Is Nothing Then
If UCase(Target) = "D" Then
With Sheets("Devis")
.Range("a" & .Cells(.Rows.Count, "a").End(xlUp).Row + 1) = Target.Offset(, -1).Value
End With
End If
End If
'------------------

--
Salutations
JJ


"Manu" a écrit dans le message de news: lv7keb$itb$

La voici...

Set Rg = Intersect(Target, Range("C:C"))
'Mich
If Not Rg Is Nothing Then
For Each C In Rg
Call Création_Répertoire(C)
Next
End If

Set Rg = Intersect(Target, Range("D:D"))
If Not Rg Is Nothing Then
If Rg.Cells.Count = 1 Then
If LCase(Rg) = "x" Then
LeRep = Chemin & Rg.Offset(, -1)
If Dir(LeRep, vbDirectory) = "" Then
Call Création_Répertoire(Rg.Offset(, -1))
Application.Wait (Now() + TimeValue("00:00:02"))
Application.EnableEvents = False
End If
If Rg.Offset(, -1) = "" Then Exit Sub
Call Choisir_Le_Fichier(LeRep & "")
Application.EnableEvents = False
Rg = ""
Application.EnableEvents = True
End If
End If
End If
End Sub

Manu


"Jacky" a écrit dans le message de groupe de discussion : lv7hgc$bgj$

Re...
Il faudra l'integré dans la même macro "Worksheet_Change" dejà existante
Donne la macro que tu utilises.

--
Salutations
JJ


"Manu" a écrit dans le message de news: lv7h3q$aij$

Ca bug dès la la 1ère ligne.... Private Sub Worksheet_Change(ByVal Target As Range)
Est-ce dû que j'ai déjà une autre macro que m'avait réalisé Mich qui commence de la même façon mais pour
autre chose...
Ne peut-on pas avoir le même Private Sub Worksheet_Change(ByVal Target As Range) de la même Feuil pour
diverses éléments souhaités...

Merci

Manu

"Jacky" a écrit dans le message de groupe de discussion : lv7gif$95m$

Bonsoir,

....copie cette valeur dans la dernière cellule vide de la colonne A

Ceci dans le module de la feuille en question
'------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Double
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("d2:d" & Cells(Rows.Count, "c").End(xlUp).Row)) Is Nothing Then
If UCase(Target) = "D" Then
x = Target.Offset(, -1).Value
With Sheets("Devis")
.Range("a" & .Cells(.Rows.Count, "a").End(xlUp).Row + 1) = x
End With
End If
End If
End Sub
'--------------------

--
Salutations
JJ


"Manu" a écrit dans le message de news: lv7d7m$b4$

Bonsoir,

Ca ressemble à une ficelle précédente où Jacky et Mich m'avait solutionné le problème, j'ai tenté avec ce
qu'ils m'ont donné d'adapter... mais vraiment impossible ! Aussi, je vous demande encore un coup de
main....

J'ai dans une colonne C des formules
Je souhaiterais que lorsque je tape "D" (peu importe la casse) dans la col D qu'il me copie la valeur de
la cellule à la gauche de où j'ai tapé "D" et qu'il me copie cette valeur dans la dernière cellule vide de
la colonne A de la Feuil "Devis"

Me suis je fais comprendre...

Encore merci pour votre aide !

Manu

---
Ce courrier électronique ne contient aucun virus ou logiciel malveillant parce que la protection avast!
Antivirus est active.
http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com

---
Ce courrier électronique ne contient aucun virus ou logiciel malveillant parce que la protection avast!
Antivirus est active.
http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com

---
Ce courrier électronique ne contient aucun virus ou logiciel malveillant parce que la protection avast!
Antivirus est active.
http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com

Bonjour,

Oups, tu as raison, la voici...

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range) 'Mich
Dim Rg As Range, C As Range, LeRep As String
Set Rg = Intersect(Target, Range("C:C"))
If Not Rg Is Nothing Then
For Each C In Rg
Call Création_Répertoire(C)
Next
End If

Set Rg = Intersect(Target, Range("D:D"))
If Not Rg Is Nothing Then
If Rg.Cells.Count = 1 Then
If LCase(Rg) = "x" Then
LeRep = Chemin & Rg.Offset(, -1)
If Dir(LeRep, vbDirectory) = "" Then
Call Création_Répertoire(Rg.Offset(, -1))
Application.Wait (Now() + TimeValue("00:00:02"))
Application.EnableEvents = False
End If
If Rg.Offset(, -1) = "" Then Exit Sub
Call Choisir_Le_Fichier(LeRep & "")
Application.EnableEvents = False
Rg = ""
Application.EnableEvents = True
End If
End If
End If
End Sub

Oui Jacky, il peut y avoir dans la même colonne un x, un d voir peut-être un
autre après

J'ai ajouté ton code où tu me l'as dis et il ne se passe rien du tout

Merci

Manu

"Jacky" a écrit dans le message de groupe de discussion :
lv7lou$m51$

Re...

Il manque une partie du code au début...
Si j'ai bien compris tu peux avoir un "x" ou un "D" dans la colonne D
Ajoute ceci à la fin du code Juste avant le "End Sub"
'--
'---------Concerne la saisie de "D" de la colonne D-------------------
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("d2:d" & Cells(Rows.Count,
"c").End(xlUp).Row)) Is Nothing Then
If UCase(Target) = "D" Then
With Sheets("Devis")
.Range("a" & .Cells(.Rows.Count, "a").End(xlUp).Row + 1) =
Target.Offset(, -1).Value
End With
End If
End If
'------------------

--
Salutations
JJ


"Manu" a écrit dans le message de news:
lv7keb$itb$

La voici...

Set Rg = Intersect(Target, Range("C:C"))
'Mich
If Not Rg Is Nothing Then
For Each C In Rg
Call Création_Répertoire(C)
Next
End If

Set Rg = Intersect(Target, Range("D:D"))
If Not Rg Is Nothing Then
If Rg.Cells.Count = 1 Then
If LCase(Rg) = "x" Then
LeRep = Chemin & Rg.Offset(, -1)
If Dir(LeRep, vbDirectory) = "" Then
Call Création_Répertoire(Rg.Offset(, -1))
Application.Wait (Now() + TimeValue("00:00:02"))
Application.EnableEvents = False
End If
If Rg.Offset(, -1) = "" Then Exit Sub
Call Choisir_Le_Fichier(LeRep & "")
Application.EnableEvents = False
Rg = ""
Application.EnableEvents = True
End If
End If
End If
End Sub

Manu


"Jacky" a écrit dans le message de groupe de discussion :
lv7hgc$bgj$

Re...
Il faudra l'integré dans la même macro "Worksheet_Change" dejà existante
Donne la macro que tu utilises.

--
Salutations
JJ


"Manu" a écrit dans le message de news:
lv7h3q$aij$

Ca bug dès la la 1ère ligne.... Private Sub Worksheet_Change(ByVal Target
As Range)
Est-ce dû que j'ai déjà une autre macro que m'avait réalisé Mich qui
commence de la même façon mais pour autre chose...
Ne peut-on pas avoir le même Private Sub Worksheet_Change(ByVal Target As
Range) de la même Feuil pour diverses éléments souhaités...

Merci

Manu

"Jacky" a écrit dans le message de groupe de discussion :
lv7gif$95m$

Bonsoir,

....copie cette valeur dans la dernière cellule vide de la colonne A

Ceci dans le module de la feuille en question
'------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Double
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("d2:d" & Cells(Rows.Count,
"c").End(xlUp).Row)) Is Nothing Then
If UCase(Target) = "D" Then
x = Target.Offset(, -1).Value
With Sheets("Devis")
.Range("a" & .Cells(.Rows.Count, "a").End(xlUp).Row + 1) = x
End With
End If
End If
End Sub
'--------------------

--
Salutations
JJ


"Manu" a écrit dans le message de news:
lv7d7m$b4$

Bonsoir,

Ca ressemble à une ficelle précédente où Jacky et Mich m'avait
solutionné le problème, j'ai tenté avec ce qu'ils m'ont donné
d'adapter... mais vraiment impossible ! Aussi, je vous demande encore un
coup de main....

J'ai dans une colonne C des formules
Je souhaiterais que lorsque je tape "D" (peu importe la casse) dans la
col D qu'il me copie la valeur de la cellule à la gauche de où j'ai tapé
"D" et qu'il me copie cette valeur dans la dernière cellule vide de la
colonne A de la Feuil "Devis"

Me suis je fais comprendre...

Encore merci pour votre aide !

Manu

---
Ce courrier électronique ne contient aucun virus ou logiciel malveillant
parce que la protection avast! Antivirus est active.
http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com

---
Ce courrier électronique ne contient aucun virus ou logiciel malveillant
parce que la protection avast! Antivirus est active.
http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com

---
Ce courrier électronique ne contient aucun virus ou logiciel malveillant
parce que la protection avast! Antivirus est active.
http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com

---
Ce courrier électronique ne contient aucun virus ou logiciel malveillant parce que la protection avast! Antivirus est active.
http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com" target="_blank" class="text-blue hover:opacity-90 " style="word-break: break-all;" rel="noopener nofollow">http://www.avast.com

Re..
Le code proposé met la valeur de la cellule de la colonne C
si un "D" est saisie dans la colonne D dans une feuille nommée "Devis"
Comme tu l'avais demandé.
Si ce n'est pas cela soit plus précis et donne le classeur ou ce code est en place.

--
Salutations
JJ

Bonjour,

Si tu veux avoir la possibilité de taper différentes lettres dans la colonne
D et que chacune de ces lettres doit générer une réponse spécifique, tu peux
simplement faire un "select case" comme ceci. Au besoin, tu pourrais ajouter
d'autres lettres pour cette colonne et allonger le "select case" avec
d'autres "case" associés avec des
actions spécifiques pour chacune des lettres....

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range, C As Range, LeRep As String
Set Rg = Intersect(Target, Range("C:C"))

If Not Rg Is Nothing Then
For Each C In Rg
Call Création_Répertoire(C)
Next
End If

Set Rg = Intersect(Target, Range("D:D"))
If Not Rg Is Nothing Then
If Rg.Cells.Count = 1 Then
Select Case LCase(Rg)
Case Is = "x"
LeRep = Chemin & Rg.Offset(, -1)
If Dir(LeRep, vbDirectory) = "" Then
Call Création_Répertoire(Rg.Offset(, -1))
Application.Wait (Now() + TimeValue("00:00:02"))
Application.EnableEvents = False
End If
If Rg.Offset(, -1) = "" Then Exit Sub
Call Choisir_Le_Fichier(LeRep & "")
Application.EnableEvents = False
Rg = ""
Application.EnableEvents = True

Case Is = "d" 'Le code de Jacky
With Sheets("Devis")
.Range("a" & .Cells(.Rows.Count, "a"). _
End(xlUp).Row + 1) = Target.Offset(, -1).Value
End With
End Select
End If
End If
End Sub

Parfait !!! oui, c'est exactement ce que je souhaitais Jacky !!! Merci
Merci Mich ! Ca fonctionne très bien !

Mais je me permet d'abuser... quel est le code que quand on tape "x" le "x"
ce supprime après car j'aimerais que ce soit idem pour le "d"

D'autre part, que dois je ajouter pour si je tape "f" toujours dans la
colonne D qu'il m'emmène directement sur la Feuil Fiche sans cette fois çi
supprimer le "f" dans la colonne D.

Et si je tape "s" toujours dans la col D qu'il me copie la valeur à sa
gauche, toujours dans la cellule A1 de la feuil Stat
Je dois certainement abuser... mais ca m'est impossible d'y arriver

Merciiiii

Manu

"MichD" a écrit dans le message de groupe de discussion :
lv92qn$kij$


Bonjour,

Si tu veux avoir la possibilité de taper différentes lettres dans la colonne
D et que chacune de ces lettres doit générer une réponse spécifique, tu peux
simplement faire un "select case" comme ceci. Au besoin, tu pourrais ajouter
d'autres lettres pour cette colonne et allonger le "select case" avec
d'autres "case" associés avec des
actions spécifiques pour chacune des lettres....

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range, C As Range, LeRep As String
Set Rg = Intersect(Target, Range("C:C"))

If Not Rg Is Nothing Then
For Each C In Rg
Call Création_Répertoire(C)
Next
End If

Set Rg = Intersect(Target, Range("D:D"))
If Not Rg Is Nothing Then
If Rg.Cells.Count = 1 Then
Select Case LCase(Rg)
Case Is = "x"
LeRep = Chemin & Rg.Offset(, -1)
If Dir(LeRep, vbDirectory) = "" Then
Call Création_Répertoire(Rg.Offset(, -1))
Application.Wait (Now() + TimeValue("00:00:02"))
Application.EnableEvents = False
End If
If Rg.Offset(, -1) = "" Then Exit Sub
Call Choisir_Le_Fichier(LeRep & "")
Application.EnableEvents = False
Rg = ""
Application.EnableEvents = True

Case Is = "d" 'Le code de Jacky
With Sheets("Devis")
.Range("a" & .Cells(.Rows.Count, "a"). _
End(xlUp).Row + 1) = Target.Offset(, -1).Value
End With
End Select
End If
End If
End Sub


---
Ce courrier électronique ne contient aucun virus ou logiciel malveillant parce que la protection avast! Antivirus est active.
http://www.avast.com

Comme ceci :

'--------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range, C As Range, LeRep As String, Ligne As Long
Set Rg = Intersect(Target, Range("C:C"))

If Not Rg Is Nothing Then
For Each C In Rg
Call Création_Répertoire(C)
Next
End If

Set Rg = Intersect(Target, Range("D:D"))
If Not Rg Is Nothing Then
If Rg.Cells.Count = 1 Then
Select Case LCase(Rg)
Case Is = "x"
LeRep = Chemin & Rg.Offset(, -1)
If Dir(LeRep, vbDirectory) = "" Then
Call Création_Répertoire(Rg.Offset(, -1))
Application.Wait (Now() + TimeValue("00:00:02"))
Application.EnableEvents = False
End If
If Rg.Offset(, -1) = "" Then Exit Sub
Call Choisir_Le_Fichier(LeRep & "")
Application.EnableEvents = False
Rg = ""
Application.EnableEvents = True

Case Is = "d"
With Sheets("Devis")
.Range("a" & .Cells(.Rows.Count, "a"). _
End(xlUp).Row + 1) = Target.Offset(, -1).Value
End With
Application.EnableEvents = False
Rg = ""
Application.EnableEvents = True

Case Is = "f"
Application.Goto Worksheets("Fiche").Range("A1"), True

Case Is = "s"
With Worksheets("Stat")
Ligne = .Range("A65536").End(xlUp).Row + 1
.Range("A" & Ligne) = Rg.Offset(, -3)
End With
Application.EnableEvents = False
Rg = ""
Application.EnableEvents = True
End Select
End If
End If
End Sub
'--------------------------------------------------------------------------