copier / Coller les valeurs avec conditions...

Il n'y a que pour le "s" que ca ne fonctionne pas, il faut que quand je tape
"s" dans la colonne D, qu'il me copie la valeur de la cellule qui se trouve
à sa gauche mais toujours en cellule A1 puis ensuite que le "s" se supprime
automatiquement de la col D, mais ca, ca fonctionne déjà.

J'ai tenté cela, mais ca ne fonctionne pas :
Ligne = .Range("A1")
.Range("A" & Ligne) = Rg.Offset(, -1)

Merci

"MichD" a écrit dans le message de groupe de discussion :
lv9sn8$p9m$1@speranza.aioe.org...

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
'--------------------------------------------------------------------------


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

Correction apportée.

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"
Worksheets("Stat").Range("A1") = Rg.Offset(, -3)
Application.EnableEvents = False
Rg = ""
Application.EnableEvents = True

End Select
End If
End If
End Sub

Waouuu !!!

Trop nickel !!! Vraiment un grand merci ! Désormais je continue... et ferais
encore appel à vos compétences au cas où...

Bonne soirée

Manu

"MichD" a écrit dans le message de groupe de discussion :
lv9v3o$vl9$1@speranza.aioe.org...

Correction apportée.

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"
Worksheets("Stat").Range("A1") = Rg.Offset(, -3)
Application.EnableEvents = False
Rg = ""
Application.EnableEvents = True

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