Figer les valeurs
Bonjour,
Je vous explique, j'ai une macro qui va importer un fichier source et ajouter des colonnes dans ce fichier source pour ensuite y mettre des formules.
En gros une fois ma source rapatrier mes formules vont chercher dans un autre onglet une référence et y copier le prix.
En fin de macro après avoir effectué les formules j'ai rajouté une ligne copier/coller les valeurs.
Je souhaiterais qu'une fois les prix rapatrié via les formules il ne bouge plus car le tarif des pièces changent d'un mois à l'autre.
Le problème est à chaque fois que je lance ma macro elle modifie les prix.
Comment figer les valeurs et que ma macro change uniquement mes nouvelles lignes importer.
Y'a t-il une fonction VBA à rajouter ou dois-je archivé dans un autre onglet et garder que le mois en cours.
Voici ma macro
Sub Importation_HERIN()
Application.ScreenUpdating = False
Dim sh As Worksheet, wf As Worksheet
Dim derlig As Long, i As Long, dl As Long, maplage As Range, j As Integer
Set sh = ThisWorkbook.Sheets("HERIN")
Workbooks.Open Filename:="S:\Repair\INFOS COMMUNES\HERIN 2\HERIN2.xlsm"
Set wf = Workbooks("HERIN2.xlsm").Sheets("HERIN2")
derlig = wf.Range("B" & Rows.Count).End(xlUp).Row
dl = sh.Range("B" & Rows.Count).End(xlUp).Row
Set maplage = sh.Range("B2:B" & dl)
For i = 2 To derlig
If Application.WorksheetFunction.CountIf(maplage, wf.Range("B" & i).Value) = 0 Then
dl = dl + 1
For j = 1 To 14
sh.Cells(dl, j).Value = wf.Cells(i, j).Value
Next
End If
Next
Workbooks("HERIN2.xlsm").Close
Application.ScreenUpdating = True
'End Sub
' Ouverture du fichier active part en fonction de la date
'
'
Dim Path_AP As String
Dim File_AP As String
Dim Current_Month As String
Dim Current_Year As Integer
Path_AP = "S:\Common\Logistique"
Current_Month = MonthName(Month(Date))
Current_Year = Year(Date)
File_AP = "Active Parts " & Current_Month & " " & Current_Year & " - NS.xls"
If Dir(Path_AP & "\" & File_AP) = "" Then
MsgBox ("Le fichier " & File_AP & " n'est pas présent dans le répertoire " & Path_AP)
Exit Sub
Else
Workbooks.Open (Path_AP & "\" & File_AP), ReadOnly:=True
End If
Windows("Active Parts " & Current_Month & " " & Current_Year & " - NS.xls").Activate
Cells.Select
Selection.Copy
Windows("HERIN.xlsm").Activate
Sheets("Active_Parts").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
' MAJ_Tarif_ActiveParts Macro
' Celà met à jour tous les tarifs des mobos, gains et coûts
Application.ScreenUpdating = False
' Mettre à jour la colonne mois en chiffre
Sheets("HERIN").Select
Range("O2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISBLANK(RC[-14]),"""",TEXT(RC[-14],""mmmm"") & YEAR(RC[-14]))"
Selection.AutoFill Destination:=Range("O2:O5000"), Type:=xlFillDefault
Range("O2:O5000").Select
' Mettre à jour le prix des mobo
Sheets("HERIN").Select
Range("Q2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-12],Active_Parts!R1C2:R65536C4,3,0),0)"
Selection.AutoFill Destination:=Range("Q2:Q566"), Type:=xlFillDefault
Range("Q2:Q566").Select
' Mettre à jour le prix du DSO
Range("R2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-13],Active_Parts!R1C2:R65536C5,4,0),0)"
Selection.AutoFill Destination:=Range("R2:R566"), Type:=xlFillDefault
Range("R2:R566").Select
' Mettre à jour le prix Coût mobo
Range("S2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-14]="""","""",Formules_Calculs!R3C1)"
Selection.AutoFill Destination:=Range("S2:S566"), Type:=xlFillDefault
Range("S2:S566").Select
' Mettre à jour Coût HERIN
Range("T2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-15]="""","""",Formules_Calculs!R3C2)"
Range("T2").Select
Selection.AutoFill Destination:=Range("T2:T566"), Type:=xlFillDefault
Range("T2:T566").Select
'Mettre à jour contrôle suite HERIN
Range("U2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-16]="""","""",Formules_Calculs!R3C3)"
Range("U2").Select
Selection.AutoFill Destination:=Range("U2:U566"), Type:=xlFillDefault
Range("U2:U566").Select
'Mettre à jour le gain possible
Range("V2").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-5]-RC[-4])+(RC[-3])-(RC[-2]+RC[-1])"
Selection.AutoFill Destination:=Range("V2:V566"), Type:=xlFillDefault
Range("V2:V566").Select
'Mettre à jour le Gain réel
Range("W2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-10]=""OK"",RC[-1],- RC[-3])"
Selection.AutoFill Destination:=Range("W2:W566"), Type:=xlFillDefault
Range("W2:W566").Select
' CopieColle_en_valeurs Macro
'
Range("Q3:W3").Select
Selection.Copy
Range("Q3:W3000").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Résultat").Select
Range("B7").Select
End Sub
Difficile sans le ou les fichiers, enlevez les données critiques et commentez ce qui ce fait et ce qui devrait se faire, un support est toujours le bienvenu!