XL 2013 Figer les valeurs après macro

geekpok

XLDnaute Nouveau
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

XLDnaute Accro
Au lieu de :
VB:
  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 :
Code:
  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
 

Discussions similaires

  • Question
Microsoft 365 Formules
Réponses
2
Affichages
403

Statistiques des forums

Discussions
311 720
Messages
2 081 907
Membres
101 836
dernier inscrit
karmon