Macro pour fixer des valeurs selon Dates

Bonsoir au forum

Avec l'aide du Forum je suis arrivé à faire cette macro.

Dans cet exemple à chaque changement de la date en A131, les valeurs qui se trouvent en B131,C131,D131....changent. Ce que je n'arrive pas à faire ce que si je change les valeurs en B131;C131;D131...sans changer la Date en A131,les valeurs doivent prendre la place des premières valeurs.

je pense qu'il faut changer au niveau Intersect, mais je n'arrive pas à le faire.

ci-dessous la macro.

si un fichier joint est indispensable faites moi signe.

merci pour votre aide.

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Range("A131"), Target) Is Nothing Then

Call DateValeur

End If

End Sub

Sub DateValeur()

Dim Cel As Object

For Each Cel In ActiveSheet.Range("A135:A165")

If Cel = Date - 1 Then

Cel.Select

ActiveCell.Offset(0, 1) = Range("B131").Value

ActiveCell.Offset(0, 2) = Range("C131").Value

ActiveCell.Offset(0, 3) = Range("D131").Value

ActiveCell.Offset(0, 4) = Range("E131").Value

ActiveCell.Offset(0, 5) = Range("F131").Value

ActiveCell.Offset(0, 6) = Range("G131").Value

ActiveCell.Offset(0, 7) = Range("H131").Value

ActiveCell.Offset(0, 8) = Range("I131").Value

ActiveCell.Offset(0, 9) = Range("J131").Value

ActiveCell.Offset(0, 10) = Range("K131").Value

ActiveCell.Offset(0, 11) = Range("L131").Value

ActiveCell.Offset(0, 12) = Range("M131").Value

ActiveCell.Offset(0, 13) = Range("N131").Value

ActiveCell.Offset(0, 14) = Range("O131").Value

ActiveCell.Offset(0, 15) = Range("P131").Value

ActiveCell.Offset(0, 16) = Range("Q131").Value

ActiveCell.Offset(0, 17) = Range("R131").Value

ActiveCell.Offset(0, 18) = Range("S131").Value

ActiveCell.Offset(0, 19) = Range("T131").Value

ActiveCell.Offset(0, 20) = Range("U131").Value

ActiveCell.Offset(0, 21) = Range("V131").Value

ActiveCell.Offset(0, 22) = Range("W131").Value

ActiveCell.Offset(0, 23) = Range("X131").Value

ActiveCell.Offset(0, 24) = Range("Y131").Value

ActiveCell.Offset(0, 25) = Range("Z131").Value

ActiveCell.Offset(0, 26) = Range("AA131").Value

ActiveCell.Offset(0, 27) = Range("AB131").Value

ActiveCell.Offset(0, 28) = Range("AC131").Value

ActiveCell.Offset(0, 29) = Range("AD131").Value

ActiveCell.Offset(0, 30) = Range("AE131").Value

ActiveCell.Offset(0, 31) = Range("AF131").Value

ActiveCell.Offset(0, 32) = Range("AG131").Value

ActiveCell.Offset(0, 33) = Range("AH131").Value

ActiveCell.Offset(0, 34) = Range("AI131").Value

ActiveCell.Offset(0, 35) = Range("AJ131").Value

ActiveCell.Offset(0, 36) = Range("AK131").Value

ActiveCell.Offset(0, 37) = Range("AL131").Value

ActiveCell.Offset(0, 38) = Range("AM131").Value

ActiveCell.Offset(0, 39) = Range("AN131").Value

ActiveCell.Offset(0, 40) = Range("AO131").Value

ActiveCell.Offset(0, 41) = Range("AP131").Value

ActiveCell.Offset(0, 42) = Range("AQ131").Value

ActiveCell.Offset(0, 43) = Range("AR131").Value

ActiveCell.Offset(0, 44) = Range("AS131").Value

ActiveCell.Offset(0, 45) = Range("AT131").Value

ActiveCell.Offset(0, 46) = Range("AU131").Value

ActiveCell.Offset(0, 47) = Range("AV131").Value

ActiveCell.Offset(0, 48) = Range("AW131").Value

GoTo Fin

End If

Next Cel

Fin:

End Sub

Bonjour,

...les valeurs doivent prendre la place des premières valeurs.

C'est quoi les premières valeurs ??

Eventuellement merci de placer un fichier au format XLS (Excel 2003 ou inférieur)

Amicalement

Dan

Edit Dan : En attendant ta réponse à ma question, je pense que la macro existante peut être modifiée comme suit :

Sub DateValeur()
'Macro modifiée par Dan le 18/01/2010
Dim Cel As Range
Dim i As Byte
For Each Cel In ActiveSheet.Range("A135:A165")
If Cel = Date - 1 Then
    With Cel
        For i = 1 To 46
            .Offset(0, i) = Cells(131, i + 1)
        Next i
    End With
End If
Next Cel
End Sub

A bientôt

Dan

Bonjour louja, dan,

Petite correction de la boucle for :

For i = 1 To 48

Pas 46, d'après le code de louja. Petite erreur d'inadvertance