VBA effacer la valeur d'une cellule sans effacer la formule

Question

Après que vous ayez hier résolu ma question concernant une liste dans une cellule, un nouveau problème se présente à moi. Dans mon application, j'ai un onglet déplacements constitué ainsi : N° actif _ Date_Intitulé_Nombre de kilomètres effectués dans lequel je saisi pour chaque actif la nature et le nombre de kilomètres parcouru par date. Tous les trois ans, afin de limiter la taille de cet onglet "Deplacements", je procède en début d'année à l'archivage des déplacements dont la date et &gt; à l'année en cours -3. Grâce à la résolution de ma précédente question, je vais changer mon fichier "Deplacements") en mettant : N°actif(qui contiendra une formule avec decaler)_Intitule actif(qui contiendra une liste)_Date_Inttulé_Nombre de kilométres parcourus. Actuellement, je copie les déplacements répondants au critère de date dans un fichier "SwitchDeplacements", et ceux ne répondant pas au critère de date dans un onglet "Tempdeplacements". Pour initialiser le fichier "SwitchDeplacement" et l'onglet "TempDeplacements", j'utilise pour l'objet Range la fonction ClearContents qui efface la valeur de la cellule mais aussi malheureusement la formule qu'elle contient. Pour finir je copie la feuille"TempDeplacements" avant la feuille "Deplacements", je supprime la feuille "Deplacements" puis je renomme la feuille "TempDeplacements" en "Deplacements" En résumé, existe t-il une fonction pour l'objet Range qui puisse uniquement effacer la valeur de la cellule sans pour autant en effacer la formule? Ou alors est ce que je fais entièrement fausse route et que la résolution de ce problème est toute autre ?! A toutes fins utiles, voici le code de cette procédure qui se déroule dans ThisWorkbook. Private Sub Workbook_Open() Dim annee Dim annee1 Dim nombdd As String Dim nombdd1 As String Dim nombdd2 As String Dim compteurlignes As Long Dim cpteur As Long Dim cpteur1 As Long Dim cpteur2 As Long Dim nblignes As Variant Application.ScreenUpdating = False annee = Year(Date) annee1 = annee - 3 cpteur = 0 cpteur1 = 0 cpteur2 = 0 compteurlignes = 0 nblignes = 0 'Si l'année du 1er enregistrement est inférieure ou égale à l'année en cours -3 'Pour rappel : la feuille ("Deplacements") est triée par date en quittant Directeur.xlsm nombdd = ("C:\TutelSoft\Trajets\") &amp; annee1 &amp; (".xlsm") If Dir(nombdd) &lt;&gt; vbNullString Then Sheets("Deplacements").Select If Year(Range("B6").Value) &lt;= annee1 Then Sheets("PAccueil").Select MsgBox ("Le programme a détecté un ou plusieurs déplacements datés de ") &amp; annee1 &amp; (" ,ou d'une année antérieure, alors que ces déplacements ont déjà été archivés. Veuillez rectifier cette erreur !"), vbInformation Else Workbooks("Directeur.xlsm").Activate Sheets("Deplacements").Select Range("A5").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToRight)).Select Selection.Sort key1:=Range("A6"), order1:=xlAscending, key2:=Range("B6"), order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal '------------------------------------------------------------------------------------------------------------------------------- Sheets("PAccueil").Select Exit Sub End If Else 'Ouverture du classeur "SwitchDepl.xls" UFArchivTrajet.Show 0 DoEvents nombdd1 = ("C:\TutelSoft\SwitchDepl.xlsm") Workbooks.Open Filename:=nombdd1 Range("A6").Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents Range("B6").Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents Range("C6").Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents Range("D6").Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents Range("E6").Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents 'Détermination du nombre de lignes dans la feuille ("Deplacements") Workbooks("Directeur.xlsm").Activate Sheets("Deplacements").Select Sheets("Deplacements").Unprotect ("ElPasoTx67110") nblignes = Range("A6").End(xlDown).Address nblignes = Range(nblignes).Row nblignes = nblignes - 5 Range("A6").Select compteurlignes = 1 cpteur = 6 cpteur1 = 6 cpteur2 = 6 Sheets("Deplacements").Select Range("B6").Select Workbooks("Directeur.xlsm").Activate Sheets("TempDeplacements").Select Range("A6").Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents Range("B6").Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents Range("C6").Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents Range("D6").Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents Range("E6").Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents Dim macellule As Variant Workbooks("Directeur.xlsm").Activate Worksheets("Deplacements").Select 'Début de la boucle du nombre de lignes Do compteurlignes = compteurlignes macellule = Range(("B") &amp; (cpteur)).Value If Year(macellule) = annee1 Then Range(("A") &amp; cpteur).Select nuprotege = ActiveCell.Value dateprotege = ActiveCell.Offset(0, 1).Value trajet = ActiveCell.Offset(0, 2).Value objetdepl = ActiveCell.Offset(0, 3).Value km = ActiveCell.Offset(0, 4).Value Workbooks("SwitchDepl.xlsm").Activate Range("A6").Select If Range("A6").Value = Empty Then Range("A6").Select Range("A6").Value = nuprotege Range("B6").Value = dateprotege Range("C6").Value = trajet Range("D6").Value = objetdepl Range("E6").Value = km Else cpteur1 = cpteur1 + 1 Range(("A") &amp; (cpteur1)).Value = nuprotege Range(("B") &amp; (cpteur1)).Value = dateprotege Range(("C") &amp; (cpteur1)).Value = trajet Range(("D") &amp; (cpteur1)).Value = objetdepl Range(("E") &amp; (cpteur1)).Value = km End If Else nuprotege = ActiveCell.Value Range(("A") &amp; cpteur).Select dateprotege = ActiveCell.Offset(0, 1).Value trajet = ActiveCell.Offset(0, 2).Value objetdepl = ActiveCell.Offset(0, 3).Value km = ActiveCell.Offset(0, 4).Value Workbooks("Directeur.xlsm").Activate Sheets("TempDeplacements").Select Range("A6").Select If Range("A6").Value = Empty Then Range("A6").Select Range("A6").Value = nuprotege Range("B6").Value = dateprotege Range("C6").Value = trajet Range("D6").Value = objetdepl Range("E6").Value = km Else cpteur2 = cpteur2 + 1 Range(("A") &amp; (cpteur2)).Value = nuprotege Range(("B") &amp; (cpteur2)).Value = dateprotege Range(("C") &amp; (cpteur2)).Value = trajet Range(("D") &amp; (cpteur2)).Value = objetdepl Range(("E") &amp; (cpteur2)).Value = km End If End If Workbooks("Directeur.xlsm").Activate Worksheets("Deplacements").Select cpteur = cpteur + 1 compteurlignes = compteurlignes + 1 ActiveCell.Offset(1, 0).Select Loop Until compteurlignes = nblignes + 1 Workbooks("SwitchDepl.xlsm").Save Workbooks("SwitchDepl.xlsm").Close FileCopy ("C:\TutelSoft\SwitchDepl.xlsm"), ("C:\TutelSoft\Trajets\") &amp; annee1 &amp; (".xlsm") Application.DisplayAlerts = False Worksheets("Deplacements").Delete Application.DisplayAlerts = True Worksheets("TempDeplacements").Copy before:=Worksheets(6) Worksheets(6).Name = ("Deplacements") Unload UFArchivTrajet Sheets("PAccueil").Select Exit Sub End If End Sub Cette problématique se présentera également pour d'autres onglets que je vais devoir archiver tous les 4 ou 5 ans. J'espère ne pas abuser de votre temps et de votre patience.... Merci à vous Cordialement Joseph...

haonv · Answer

Je ne connais pas grand chose (plutôt rien...) en vba ,mais effacer la valeur d'une cellule sans effacer sa formule ? D'ailleurs , je serai tenter de dire que la valeur de la cellule est la formule elle-même.Je pense que ce sont les valeurs des "antécédents" qu'il faut effacer. exemple: si on a en A2 :"=A1" pour effacer la valeur en A2 ,on supprime la valeur de A1. Si tu veux archiver des données ,il faudrait plutot que tu copies les cellules que tu veux archiver ,faire un "collage spécial";"valeurs"sur ta feuille d'archive.Ensuite tu effaces les "antécédents" sur ta feuille de calcul.Tes formules seront toujours là. Espérant d'avoir aidé. Amicalement...