Transfert de données
Bonjour
J'ai créé un fichier qui me permet de transférer des données pour conserver l'historique des travaux en cours sur une feuille a cet effet.
Les données sont transférées en cliquant "transfert" dans un menu déroulant.
Le code fonctionne bien, les informations sont transférées comme prévu et effacées automatiquement de la feuille d'origine.
Le problèmes est que certaines cellules contiennent une formule et celle-ci est effacée lors du transfert.
Est-il possible de transférer le texte et de conserver les formules?
Merci
Bonjour,
la majorité des intervenants ici vont te demander ton fichier anonymisé car personne n'a de boule de cristal
P.
Voici le fichier joint
Il s'agit d'un fichier en construction.
Les formules sont en J17:J37 et K17:K37
Le menu déroulant est en Q17:Q37
En cliquant "Libéré" dans le menu déroulant les données sont transférées dans la feuille Histo en effaçants les cellules H17:V17 etc...de la feuille Gabari.
Ma question est de savoir si c'est possible de transférer le texte et de conserver les formules.
Ci-dessous le code
Private Const feuilleTravail As String = "Gabari"
Private Const feuilleSauvegarde As String = "Histo"
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Rows.Count <> 1 Or Target.Columns.Count <> 1 Then Exit Sub
If Target.Column <> 17 Or Target.Row < 17 Or Target.Value = "" Then Exit Sub
col = Target.Row
Select Case Target.Value
Case "Complété"
lettre = "U"
Range(lettre & col).Select
If Range(lettre & col) = "" Then Range(lettre & col) = Now
Selection.Locked = True
Selection.FormulaHidden = False
Case "En Cours"
lettre = "s"
Range(lettre & col).Select
If Range(lettre & col) = "" Then Range(lettre & col) = Now
Selection.Locked = True
Selection.FormulaHidden = False
Case "Libéré"
Dim transfert As Variant
Dim derniereLigne%
derniereLigne = Sheets(feuilleSauvegarde).Cells(Sheets(feuilleSauvegarde).Rows.Count, "A").End(xlUp).Row
transfert = Sheets(feuilleTravail).Range("B" & col & ":V" & col)
Sheets(feuilleSauvegarde).Range("A" & derniereLigne + 1).Resize(1, UBound(transfert, 2) - LBound(transfert, 1) + 2) = transfert
Sheets(feuilleTravail).Range("H" & col & ":V" & col).ClearContents
End Select
End Sub