Bonjour
J'ai une macro qui permet de générer plusieurs classeurs à partir d'un classeur d'origine.
Dans une colonne de ces nouveaux classuers je dois effectuer un calcul, je le fais à partir de ce code :
Mais je souhaiterais que le calcul soit effectué non pas jusqu'à la ligne 2000 mais jusqu'à la dernière ligne, tous les codes que j'ai essayé ne tiennent pas compte de ce critère et recopient au delà de cette dernière ligne, pouvez vous m'aiguiller ?
En réalité ma formule existe dans mon classeur d'origine mais n'est pas recopié dans les fichiers créés, voici l'intégralité du code si il est possible tout simplement de conserver la copie de la formule :
Merci beaucoup
J'ai une macro qui permet de générer plusieurs classeurs à partir d'un classeur d'origine.
Dans une colonne de ces nouveaux classuers je dois effectuer un calcul, je le fais à partir de ce code :
Code:
Range("P2").Select
ActiveCell.FormulaR1C1 = "=IF([@[OA'#]]="""","""",IF([@[Revised D]]="""","""",[@[Revised D]]-[@[Order D]]))"
Selection.AutoFill Destination:=Range("P2:P2000")
Mais je souhaiterais que le calcul soit effectué non pas jusqu'à la ligne 2000 mais jusqu'à la dernière ligne, tous les codes que j'ai essayé ne tiennent pas compte de ce critère et recopient au delà de cette dernière ligne, pouvez vous m'aiguiller ?
En réalité ma formule existe dans mon classeur d'origine mais n'est pas recopié dans les fichiers créés, voici l'intégralité du code si il est possible tout simplement de conserver la copie de la formule :
Code:
Sub CreeClasseurs()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Kill "S:...\*.*"
[A4:AE4000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[AI4], Unique:=True
For Each c In Range("AI5", Range("AI65000").End(xlUp))
Range("AI5") = c
Sheets.Add
Sheets("Feuil1").[A4:AE4000].AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Feuil1").[AI4:AI5], CopyToRange:=[A1], Unique:=False
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$AE$2000"), , xlYes).Name = _
"Tableau2"
ActiveSheet.Columns("A:AE").AutoFit
ActiveSheet.Range("A:A,B:B,C:C,F:F,G:G").EntireColumn.Hidden = True
ActiveSheet.Range("D1") = "Production Manager"
ActiveSheet.Range("H1") = "Supplier"
ActiveSheet.Range("E1") = "OA#"
ActiveSheet.Range("I1") = "Style"
ActiveSheet.Range("J1") = "Color"
ActiveSheet.Range("K1") = "Size"
ActiveSheet.Range("L1") = "Order Quantity"
ActiveSheet.Range("M1") = "Order ETD"
ActiveSheet.Range("N1") = "Order Warehouse Date"
ActiveSheet.Range("O1") = "Revised ETD"
ActiveSheet.Range("P1") = "Delay"
ActiveSheet.Range("Q1") = "Partial Qty"
ActiveSheet.Range("R1") = "Balance"
ActiveSheet.Range("Z1") = "FRI status"
ActiveSheet.Range("AE1") = "Warehouse Date"
ActiveSheet.Range("AF1") = "Comments"
ActiveSheet.Copy
nf = Replace(Replace(Replace(Replace(Replace(c, "/", "_"), "&", "_"), "...", "_"), ".", "_"), " ", "_")
Application.ScreenUpdating = False
' Mise en forme conditionnelle
Range("$Y:$Y").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=SI($O1<>"""";$Y1>=$O1;$Y1>=$M1)"
Selection.FormatConditions(1).Interior.ColorIndex = 3
Selection.FormatConditions(1).Font.ColorIndex = 1
Range("F1006").End(xlUp).Offset(1, 0).Select
Range("P2").Select
ActiveCell.FormulaR1C1 = "=IF([@[OA'#]]="""","""",IF([@[Revised D]]="""","""",[@[Revised D]]-[@[Order D]]))"
Selection.AutoFill Destination:=Range("P2:P2000")
' Suite du code
ActiveSheet.Name = Left(nf, 31)
ActiveWorkbook.SaveAs Filename:="C:...\" & "Production_status_" & nf & "_" & Format(Date, "d-mm-yy")
ActiveWorkbook.Close
ActiveSheet.Delete
Next c
' Ouverture de la boîte de dialogue
MsgBox "Les fichiers ont bien été créés ... !"
Shell "explorer.exe C:...", 1
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Merci beaucoup
Dernière édition: