Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2013 Figer les valeurs après macro

  • Initiateur de la discussion Initiateur de la discussion geekpok
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

G

geekpok

Guest
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
 
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.
 
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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

B
  • Résolu(e)
2
Réponses
16
Affichages
2 K
benbella1991
B
L
Réponses
9
Affichages
1 K
J
  • Question Question
Microsoft 365 Formules
Réponses
2
Affichages
777
J
J
Réponses
22
Affichages
3 K
jui42
J
Réponses
2
Affichages
1 K
Réponses
13
Affichages
2 K
Réponses
1
Affichages
1 K
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…