bonjour,
j'ai été aidé par Mr, sylnanu pour créer le code ci dessus, et quand je l'ai adapté selon mes besoins, je ne savais pas comment le copier dans le fichier excel et comment le faire exécuter
merci d'avance pour l'aide
voila le code adapté:
Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, [C6]) Is Nothing Then
Application.ScreenUpdating = False
Application.EnableEvents = False
DL = [A1000000].End(xlUp).Row
If DL > 8 Then Range("A9:M" & DL).ClearContents
Parc = Target
With Sheets("journale de maintenance")
Ligne = 9
DL = .[A1000000].End(xlUp).Row
For L = 7 To DL
If .Cells(L, "B") = Parc Then
CopieLigne L, Ligne
Ligne = Ligne + 1
End If
Next L
End With
End If
Fin:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Sub CopieLigne(L, Ligne)
Application.ScreenUpdating = False
With Sheets("journale de maintenance")
Cells(Ligne, 1) = .Cells(L, 1) 'date
Cells(Ligne, 2) = .Cells(L, 4) 'N°série
Cells(Ligne, 3) = .Cells(L, 5) 'compteur
Range(Cells(Ligne, 4), Cells(Ligne, 10)) = .Range(.Cells(L, 7), .Cells(L, 13)).Value ' de type travaux à PDR
Cells(Ligne, 14) = .Cells(L, 24) 'AGENTS
Cells(Ligne, 15) = .Cells(L, 23) 'MONTANT PDR
Cells(Ligne, 16) = .Cells(L, 25) 'Coût
End With
End Sub
j'ai été aidé par Mr, sylnanu pour créer le code ci dessus, et quand je l'ai adapté selon mes besoins, je ne savais pas comment le copier dans le fichier excel et comment le faire exécuter
merci d'avance pour l'aide
voila le code adapté:
Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, [C6]) Is Nothing Then
Application.ScreenUpdating = False
Application.EnableEvents = False
DL = [A1000000].End(xlUp).Row
If DL > 8 Then Range("A9:M" & DL).ClearContents
Parc = Target
With Sheets("journale de maintenance")
Ligne = 9
DL = .[A1000000].End(xlUp).Row
For L = 7 To DL
If .Cells(L, "B") = Parc Then
CopieLigne L, Ligne
Ligne = Ligne + 1
End If
Next L
End With
End If
Fin:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Sub CopieLigne(L, Ligne)
Application.ScreenUpdating = False
With Sheets("journale de maintenance")
Cells(Ligne, 1) = .Cells(L, 1) 'date
Cells(Ligne, 2) = .Cells(L, 4) 'N°série
Cells(Ligne, 3) = .Cells(L, 5) 'compteur
Range(Cells(Ligne, 4), Cells(Ligne, 10)) = .Range(.Cells(L, 7), .Cells(L, 13)).Value ' de type travaux à PDR
Cells(Ligne, 14) = .Cells(L, 24) 'AGENTS
Cells(Ligne, 15) = .Cells(L, 23) 'MONTANT PDR
Cells(Ligne, 16) = .Cells(L, 25) 'Coût
End With
End Sub