XL 2013 Figer les valeurs après macro

[geekpok]

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

 

[danielco]

Bonjour,

Il ne faut pas que la macro colle des formules dans les cellules. A la place, elle doit effectuer le calcul et coller le résultat ans ces cellules.

Cordialement.

Daniel

 

[geekpok]

OK je comprend le problème peux tu me donner un exemple sur une des colonnes comment faire ma VBA pour quel effectue les formules sans la coller dans la cellules stp.

 

[danielco]

Au lieu de :

  Range("Q2").Select
  ActiveCell.FormulaR1C1 = _
  "=IFERROR(VLOOKUP(RC[-12],Active_Parts!R1C2:R65536C4,3,0),0)"
  Selection.AutoFill Destination:=Range("Q2:Q566"), Type:=xlFillDefault

Mets :

  Dim C As Range
  With Sheets("HERIN")
    For Each C In .Range("Q2", .Cells(.Rows.Count, 17).End(xlUp))
      If IsNumeric(Application.VLookup(C.Offset(, -11), [Active_Parts!B1:D65536], 3, 0)) Then
        C.Value = Application.VLookup(C.Offset(, -11), [Active_Parts!B1:D65536], 3, 0)
      Else
        C.Value = 0
      End If
    Next C
  End With

Daniel