Macro

[Mokia]

Bonjour
pour expliquer simplement ce que je veux. Je voudrais que quand j'écrive quelque chose dans B2, je voudrais que la valeur se reporte automatiquement en B6, puis C2 dans C6, et ainsi de suite jusqu'en J.
Je dois effectuer cela pour plusieurs lignes : la 2 se reporte dans la 6, la 3 dans la 7 et la 4 dans la 8 etc... jai mis le fichier en copie pour plus de clarté...

Jai tenté :
Private Sub Worksheet_Change(ByVal Target As Range)
Range("A3:J3").Value = Range("a1:j1").Value
End Sub

mais le problème cest qu'apparemment c'est très lourd (car je dois l'effectuer pour 8 lignes différentes dans mon vrai fichier). et jai une contrainte : je ne peux pas ordonner les lignes)
:s

j'ai tenté aussi ca :
Sub calculs()
For i = 2 To 6
Cells(6, i).Value = Cells(2, i).Value
Next i
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 And Target.Address(0, 0) = "B2:B6" Then calculs
End Sub
mais là il faut activer la macro sans arret pour que la copie se fasse.

Je dois en+ appliquer la macro à toutes les feuilles de mon classeur.

Est ce que quelqu'un pourrait m'aider svp??

merci beaucoup !!!!!!!!!!!!!!

 

[Mokia]

Re : Macro

pitié de l'aide lol

 

[Pierrot93]

Re : Macro

Bonjour,

avec ce que j'ai compris.... pas sûr d'avoir tout capté... code ci-dessous à placer dans le module "thisworkbook", s'appliquera à toutes les feuilles du classeur...

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("B2:F4")) Is Nothing Then
    With Application
        .EnableEvents = False
        Target.Offset(4) = Target
        .EnableEvents = True
    End With
End If
End Sub

A noter, ton titre n'st pas très explicite pour des recherches ultérieures.... il est souhaitable que tu le modifie....
bonne journée
@+

 

[Dormeur74]

Re : Macro

Pourquoi ne pas écrire en B6 la formule =B2 ? Etc.

 

[Mokia]

Re : Macro

car si je fais ca , la macro suivante ne marche plus :
For J = 2 To Fin_Plage
If Application.CountA(Range(Cells(2, J), Cells(4, J))) > 2 Then
MsgBox "Permanence minimale atteinte !"
Target = ""
Next J
End If