excellentt
XLDnaute Nouveau
Bonjour,
je veux qu'une macro s'execute automatiquement des qu'une cellule de la feuille est recalculée.
J'ai créé une Private sub worksheet calculate() que j'ai placé dans l'onglet de la feuille. Celle ci ne s'execute pas automatiquement lorsque les donées sont mise a jour.
Comprends pas.
Private Sub Worksheet_Calculate()
Dim i As Integer
Dim z As Integer
Pause = 60
Début = Timer
Do While Timer < Début + Pause
DoEvents ' Donne le contrôle à d'autres processus.
Loop
'Application.ScreenUpdating = False
Application.EnableEvents = False
With Sheets("portefeuille- compte")
For z = 10 To 55 Step 1
If .Cells(z, 16).Value = "VENTE" Then
.Range(.Cells(z, 1), .Cells(z, 16)).Copy
Sheets("histo").Range("A5").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("histo").Rows("5:5").Insert Shift:=xlDown
With Sheets("portefeuille- compte")
.Rows(z & ":" & z).Delete Shift:=xlUp
End With
Application.CutCopyMode = False
Else
If .Cells(z, 16).Value = "FIN" Then
Exit Sub
Else
i = 9
With Sheets("passage ordre")
For i = 9 To 55 Step 1
If .Cells(i, 9).Value = "ACHAT" Then
If .Cells(i, 2).Value <> "FAUX" Then
If IsNumeric(.Cells(i, 8)) Then
If .Cells(i, 8).Value <= (.Cells(4, 2).Value + .Cells(5, 2).Value) Then
.Range(.Cells(i, 1), .Cells(i, 8)).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
Else
End If
Else
End If
Else
End If
Else
End If
Next i
End With
End If
End If
Next z
End With
Application.EnableEvents = True
'Application.ScreenUpdating = True
End Sub
merci pour vos reponses
je veux qu'une macro s'execute automatiquement des qu'une cellule de la feuille est recalculée.
J'ai créé une Private sub worksheet calculate() que j'ai placé dans l'onglet de la feuille. Celle ci ne s'execute pas automatiquement lorsque les donées sont mise a jour.
Comprends pas.
Private Sub Worksheet_Calculate()
Dim i As Integer
Dim z As Integer
Pause = 60
Début = Timer
Do While Timer < Début + Pause
DoEvents ' Donne le contrôle à d'autres processus.
Loop
'Application.ScreenUpdating = False
Application.EnableEvents = False
With Sheets("portefeuille- compte")
For z = 10 To 55 Step 1
If .Cells(z, 16).Value = "VENTE" Then
.Range(.Cells(z, 1), .Cells(z, 16)).Copy
Sheets("histo").Range("A5").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("histo").Rows("5:5").Insert Shift:=xlDown
With Sheets("portefeuille- compte")
.Rows(z & ":" & z).Delete Shift:=xlUp
End With
Application.CutCopyMode = False
Else
If .Cells(z, 16).Value = "FIN" Then
Exit Sub
Else
i = 9
With Sheets("passage ordre")
For i = 9 To 55 Step 1
If .Cells(i, 9).Value = "ACHAT" Then
If .Cells(i, 2).Value <> "FAUX" Then
If IsNumeric(.Cells(i, 8)) Then
If .Cells(i, 8).Value <= (.Cells(4, 2).Value + .Cells(5, 2).Value) Then
.Range(.Cells(i, 1), .Cells(i, 8)).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
Else
End If
Else
End If
Else
End If
Else
End If
Next i
End With
End If
End If
Next z
End With
Application.EnableEvents = True
'Application.ScreenUpdating = True
End Sub
merci pour vos reponses