excellentt
XLDnaute Nouveau
J'ai ecrit cette macro ( avec l'aide du forum )
Elle semblait bien marcher mais a de plus en plus de mal a s'executer ( je ne sais pas pourquoi )
Elle se lancais lorsque je changais une valeur dans la plage manuellement.
Y'a t'il une astuce pour que la macro se lance automatiquement si une valeur dans les cellules de la plage change ?
cdlt
Private Sub Worksheet_Change(ByVal Target As Range)
'Dim flag As Boolean
Dim i As Integer
Dim Plage As Range, Intersection As Range
If flag = True Then Exit Sub
flag = True
Application.EnableEvents = False
Set Plage = Range("B9:B55")
Set Intersection = Application.Intersect(Plage, Target)
If Not (Intersection Is Nothing) Then
With Sheets(Target.Worksheet.Name)
For i = 9 To 55 Step 1
If .Cells(i, 8).Value = "ACHAT" Then
If .Cells(i, 2).Value <> "FAUX" Then
If IsNumeric(.Cells(i, 7)) Then
If .Cells(i, 7).Value < .Cells(4, 2).Value Then
.Range(.Cells(i, 1), .Cells(i, 7)).Copy
Sheets("portefeuille- compte").Range("A9").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("portefeuille- compte").Rows("9:9").Insert Shift:=xlDown
With Sheets("portefeuille- compte")
.Rows(8).Copy .Rows(9)
End With
.Range(.Cells(i, 1), .Cells(i, 7)).Copy
Sheets("histo").Range("A5").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("histo").Rows("5:5").Insert Shift:=xlDown
Else
End If
Else
End If
Else
End If
Else
End If
Next i
End With
End If
flag = False
Application.EnableEvents = True
End Sub
Elle semblait bien marcher mais a de plus en plus de mal a s'executer ( je ne sais pas pourquoi )
Elle se lancais lorsque je changais une valeur dans la plage manuellement.
Y'a t'il une astuce pour que la macro se lance automatiquement si une valeur dans les cellules de la plage change ?
cdlt
Private Sub Worksheet_Change(ByVal Target As Range)
'Dim flag As Boolean
Dim i As Integer
Dim Plage As Range, Intersection As Range
If flag = True Then Exit Sub
flag = True
Application.EnableEvents = False
Set Plage = Range("B9:B55")
Set Intersection = Application.Intersect(Plage, Target)
If Not (Intersection Is Nothing) Then
With Sheets(Target.Worksheet.Name)
For i = 9 To 55 Step 1
If .Cells(i, 8).Value = "ACHAT" Then
If .Cells(i, 2).Value <> "FAUX" Then
If IsNumeric(.Cells(i, 7)) Then
If .Cells(i, 7).Value < .Cells(4, 2).Value Then
.Range(.Cells(i, 1), .Cells(i, 7)).Copy
Sheets("portefeuille- compte").Range("A9").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("portefeuille- compte").Rows("9:9").Insert Shift:=xlDown
With Sheets("portefeuille- compte")
.Rows(8).Copy .Rows(9)
End With
.Range(.Cells(i, 1), .Cells(i, 7)).Copy
Sheets("histo").Range("A5").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("histo").Rows("5:5").Insert Shift:=xlDown
Else
End If
Else
End If
Else
End If
Else
End If
Next i
End With
End If
flag = False
Application.EnableEvents = True
End Sub