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

Rechercher des sujets similaires à "transfert donnees"