copier / Coller les valeurs avec conditions...
Le
Manu
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 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
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"
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,
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" lv7d7m$b4$
---
Ce courrier électronique ne contient aucun virus ou logiciel malveillant parce que la protection avast! Antivirus est active.
http://www.avast.com
Il faudra l'integré dans la même macro "Worksheet_Change" dejà existante
Donne la macro que tu utilises.
--
Salutations
JJ
"Manu"
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" lv7h3q$aij$
---
Ce courrier électronique ne contient aucun virus ou logiciel malveillant parce que la protection avast! Antivirus est active.
http://www.avast.com
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"
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" lv7keb$itb$
---
Ce courrier électronique ne contient aucun virus ou logiciel malveillant parce que la protection avast! Antivirus est active.
http://www.avast.com
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
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
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
'--------------------------------------------------------------------------
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
'--------------------------------------------------------------------------