Débutant Probléme avec Worksheet Change

[demichoux]

Bonjour a tous,

Mon probléme est le suivants, j'ai fait un code vba qui me permet de remplir une partie de mon tableau ( date; date +15jrs; cela copie la mise en forme de la ligne du dessus; etc..) excel lors de la détection d'une cellule vide dans la colonne B et non vide dans la colonne C mais des que je double clique dans une des cellules de la colonne C cela me modifie ma date ou parfois cela me supprime mes donées ou la mise en forme. J'aimerais enfaite qu'une fois j'ai saisie une valeur dans la colonne C si jamais je la modifie, cela n'entraine pas la modification de la ladate ou supprime la mise en forme etc...

ci-dessous le code que j'ai fait avec le peut de connaissance que j'ai en VBA ( comme vous pourrez le constater j'ai essaye de trouver une solution avec 'Application.EnableEvents = False ou 'Application.ScreenUpdating = False mais sans succées)

Private Sub Worksheet_Change(ByVal Target As Range)

'Application.EnableEvents = False
'Application.ScreenUpdating = False
If Target.Column = 3 Then

    'Incrémentation date enregistrement/réponse souhaitée + Etat action + Retard + Créateur actions

If Not (IsEmpty(Range("C" & Target.Row).Value)) Then IsEmpty (Range("B" & Target.Row).Value)
     'If Not (IsEmpty(Target.Value)) Then

    Range("N" & Target.Row).Value = Date
    Range("M" & Target.Row).Value = Date + 15
    Range("B" & Target.Row).Value = Range("B" & Target.Row - 1).Value + 1
    Range("J" & Target.Row).Value = "FAUX"
    Range("I" & Target.Row).Value = "En cours"
    Range("P" & Target.Row).Value = Environ("username")

    'Copie formule pour indicateur

    Range("L" & Target.Row) = "=IF(YEAR(RC[-1])<2010,IF(RC[-1]="""","""",CONCATENATE(YEAR(RC[-1]),""_"",NO.SEMAINE(RC[-1],2))), IF(RC[-1]="""","""",CONCATENATE(YEAR(RC[-1]),""_"",NO.SEMAINE(RC[-1],2)-1)))"
    Range("O" & Target.Row) = "=IF(YEAR(RC[-1])<2010,IF(RC[-1]="""","""",CONCATENATE(YEAR(RC[-1]),""_"",NO.SEMAINE(RC[-1],2))), IF(RC[-1]="""","""",CONCATENATE(YEAR(RC[-1]),""_"",NO.SEMAINE(RC[-1],2)-1)))"
    Range("Q" & Target.Row) = "=IF(RC[-5]="""","""",RC[-4]-RC[-3])"

    ' Copie mise en forme cellule du dessus

    Range("B" & Target.Row - 1 & ":Q" & Target.Row - 1).Copy
    Range("B" & Target.Row & ":Q" & Target.Row).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
   Application.CutCopyMode = False
   Range("D" & Target.Row).Select

    Else
    

    Range("N" & Target.Row).ClearContents
    Range("M" & Target.Row).ClearContents
    Range("B" & Target.Row).ClearContents
    Range("J" & Target.Row).ClearContents
    Range("I" & Target.Row).ClearContents
    Range("P" & Target.Row).ClearContents
    Range("L" & Target.Row).ClearContents
    Range("O" & Target.Row).ClearContents
    End If
End If
End If


 'Code pour passer de l'état En cours à Clos
   
 If Target.Column = 11 Then

        If Not (IsEmpty(Range("K" & Target.Row).Value)) Then

        Range("I" & Target.Row).Value = "Clos"

        Else
        Range("I" & Target.Row).Value = "En cours"

        End If
   End If
   
    'Code pour griser la ligne quand action clos
   
     If Target.Column = 9 Then
        If Range("I" & Target.Row).Value = "Clos" Then

        Range("B" & Target.Row, "K" & Target.Row).Interior.ColorIndex = 15
        Range("M" & Target.Row, "N" & Target.Row).Interior.ColorIndex = 15
        Range("P" & Target.Row).Interior.ColorIndex = 15
        
        Else
        Range("B" & Target.Row, "K" & Target.Row).Interior.ColorIndex = 0
        Range("M" & Target.Row, "N" & Target.Row).Interior.ColorIndex = 0
        Range("P" & Target.Row).Interior.ColorIndex = 0
        End If
   End If
   
   'Code pour supprimer les bordures
   
 If Target.Column = 3 Then
    If Not (IsEmpty(Range("C" & Target.Row).Value)) Then
    
        Else
    If Range("B" & Target.Row).Value = "" Then
    Range("B" & Target.Row, "Q" & Target.Row).Activate
    Range("B" & Target.Row, "Q" & Target.Row).Select
    
    Selection.Borders.LineStyle = 0
    Selection.Interior.ColorIndex = 2
  
    Range("C" & Target.Row).Select
    End If
    End If
 End If
' Application.EnableEvents = True
' Application.ScreenUpdating = True
End Sub

Merci d'avance

 

[jpb388]

Re : Débutant Probléme avec Worksheet Change

bonjour à tous

Range("B" & Target.Row - 1 & ":Q" & Target.Row - 1).Copy
Range("B" & Target.Row & ":Q" & Target.Row).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Si la ligne du dessus est vide la cellule n' a pas de format date et le retransmet à la cellule du dessous qui perd le format date et ainsi de suite
en conséquence ou tu fais une ligne témoin ou tu formates chaque cellule
et si possible joindre un petit fichier c'est plus facile
merci
a+