Solution VBA effacer valeur d'1 cell.sans effacer la formule

Question

Je me permets au vu du nombre de personnes qui se sont intéressées à ma question VBA comment effacer la valeur d'une cellule sans en effacer la formule, d'exposer la solution que j'ai trouvée, sans prétention aucune, mais seulement au cas où celà pourrait servir. J'ai une base de données EXCEL dans laquelle pour plusieurs onglets dont l'onglet "Deplacements", et ce afin d'éviter d'avoir un trop grand nombre d'enregistrements, je procédais via ThisWorkbook à un archivage automatique pour les déplacements datés de plus de 3 ans. Auparavant, aucun problème, car je n'avais pas de formule dans cette feuille de calcul. Mais grâce à ce site, j'ai pu mettre dans cette feuille une liste qui permet de choisir un actif dans cette dernière et qui donne le numéro qui lui est affecté. Donc plus possible d'appliquer mon code VBA précédent sans écraser les formules. La solution m'est venue en me rappelant une réflexion de l'un d'entre vous à une précédente question de ma part, et qui y répondait par un copier/coller. Il a suffit de créer un onglet DeplacementsVierges "DV" contenant toutes les formules, et par le biais de copier et renommer cet onglet, ainsi que d'un couper/coller les enregistrements correspondants aux critères de date pour solutionner mon souci. Je joint un fichier d'essai qui sera bien plus parlant. En éxécutant la macro "archivagedeplacement", les 5 premiers enregistrement de D vont en SD, et les autres en D. Les feuilles D, TD gardant intactes leurs formules. Désolé, mais le code "plante" en version antérieure à Excel 2007. Voici le code VBA : Sub ArchivageDeplacements() ' ArchivageDeplacements Macro Sheets("SD").Select Range("A6:J11").Select Selection.Clear Range("A6").Select Sheets("TD").Select Range("A6:J17").Select Selection.Clear Range("A6").Select Sheets("D").Select Range("A6:J10").Select Selection.Cut Sheets("SD").Select Range("A6").Select ActiveSheet.Paste Range("A6").Select Sheets("D").Select Range("A11:J14").Select Selection.Cut Sheets("TD").Select Range("A6").Select ActiveSheet.Paste Range("A6").Select Sheets("D").Select Application.DisplayAlerts = False ActiveWindow.SelectedSheets.Delete Application.DisplayAlerts = True Sheets("DV").Select Sheets("DV").Copy Before:=Sheets(7) Sheets("DV (2)").Select Sheets("DV (2)").Name = "D" Range("A6").Select Sheets("TD").Select Range("A6:J9").Select Selection.Cut Sheets("D").Select ActiveSheet.Paste Range("A6").Select Sheets("TD").Select Application.DisplayAlerts = False ActiveWindow.SelectedSheets.Delete Application.DisplayAlerts = True Sheets("DV").Select Sheets("DV").Copy After:=Sheets(8) Sheets("DV (2)").Select Sheets("DV (2)").Name = "TD" Range("A6").Select Sheets("D").Select Range("A6").Select End Sub https://www.excel-pratique.com/~files/doc2/ArchivageDeplacements.xlsm Ceci prouvant une fois de plus que l'enrichissement vient du partage et du dialogue. Cordialement Joseph...

Nad-Dan · Answer

Même si cela plante, merci de mettre ton fichier au format excel 2003 ou inférieur. De ce que j'ai compris essaie toutefois ce code Sub ArchivageDeplacements() ' ArchivageDeplacements Macro Sheets("SD").Range("A6:J11").Clear Sheets("TD").Range("A6:J17").Clear With Sheets("D") .Range("A6:J10").Cut Destination:=Sheets("SD").Range("A6") .Range("A11:J14").Cut Destination:=Sheets("TD").Range("A6") Application.DisplayAlerts = False .Delete Application.DisplayAlerts = True End With Sheets("DV").Copy Before:=Sheets(Sheets.Count) ActiveSheet.Name = "D" With Sheets("TD") .Range("A6:J9").Cut Destination:=Sheets("D").Range("A6") Application.DisplayAlerts = False .Delete Application.DisplayAlerts = True End With Sheets("DV").Copy After:=Sheets(sheets.count) ActiveSheet.Name = "TD" Sheets("D").Select End Sub Je n'ai pas trop compris le pourquoi de la suppression de la feuille D pour la recréer ensuite Amicalement Dan...